annye | Bonjour à tous, Etant débutante en VBA depuis une semaine, et ayant été grandement aidé par ce forum, je viens vous poser une "petite" ("Grande" pour moi!) question.
Je collecte un nombre de données assez important pour plein d'individus. A chaque fois, j'ai une feuille nommée "FeuillesPropres" dans laquelle j'ai un tableau récapitulant les informations de chaque individus. Chaque individu porte un numéro spécifique (contenu dans la colonne F), et un nombre de lignes spécifiques. Ce que je voudrais faire, c'est qu'à partir de ce tableau, excel me crée une feuille par individu (dont le nom est le numéro de l'individu), et qu'il y colle la première ligne de la "FeuillesPropres" ainsi que toutes les lignes de ce sujet. Autrement dit, pour l'individu 1, ma macro doit créer une feuille "1", et coller toutes les lignes dont la colonne F de mon tableau est égal à 1.
Ce qu'il faut savoir, c'est que j'aimerai que cette macro puisse être réutilisée pour plein d'études différentes, c'est à dire pour un nombre d'individu inconnu et pour un nombre de lignes et de colonnes par individu inconnu.
Jusqu'à maintenant, j'ai réussi à faire en sorte qu'une feuille par individu soit créée mais je n'arrive pas du tout à lui demandé de me copier et coller les lignes correspondant à mon individu.
J'espère que ce message est claire ... et surtout que l'un d'entre vous réussira à mettre fin à mon supplice !!!!
Pardon par avance pour toutes les horreurs que vous trouverez dans cette macro reflétant mon niveau de VBA !
Merci par avance, je mets juste en dessous le code de ma macro !
Code :
- Sub TransfereFeuilleSujets()
- ' la macro doit transferer les résultats de chaque personne dans la feuille qui lui correspond
- 'Ne pas rafraichir l'écran pendant l'execution de la macro
- Application.ScreenUpdating = False
- 'definition de la derniere ligne du tableau
- Dim DernLign As Long
- DernLign = Range("F" & Rows.Count).End(xlUp).Row + 50
- 'Recuperation du nbr de sujets
- Range("C2" ).Select
- ActiveCell.FormulaR1C1 = "=COUNT(C[-1])"
-
- 'Report du num de sujet dans la colonne B
- Range("B2" ).Select
- ActiveCell.FormulaR1C1 = "=IF(RC[4]=R[-1]C[4],"""",IF(RC[4]="""","""",RC[4]))"
- Range("B2" ).Select
- Selection.AutoFill Destination:=Range("B2:B3000" ), Type:=xlFillDefault
- Range("B2:B3000" ).Select
- ActiveWindow.SmallScroll Down:=DernLign
-
- 'Copier / coller des valeurs de la colonne B dans A pour qu'il ne detecte que des cellules vides et non pas des cellules avec formules lors de l'étape précédente
- Range("B2:B" & DernLign).Select
- Selection.Copy
- Worksheets("FeuillesPropres" ).Range("A2:A" & DernLign).Select
- Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
- False, Transpose:=False
- '' ==> La macro fonctionne bien jusqu'ici!!
- 'Creation de feuilles correspondant à chaque personne selon son numéro
- Dim Plage_sujets As Range
- Dim nom, C
- Set Plage_sujets = Range(Cells(3, 1), Cells(DernLign, 1))
- Dim nom_sujet As Range
- Dim nomSujet, NS
- Set Plage_numlignesujet = Range(Cells(3, 6), Cells(DernLign, 6)) 'Activer la colonne F de la feuille "FeuillesPropres" (Est ce que c'est bien ça??)
- For Each C In Plage_sujets
- If C.Value <> "" Then
- For Each NS In Plage_numlignesujet
- If C.Value = NS.Value Then
- Rows(ActiveCell.Row).Copy 'Copier toutes les lignes dont la valeur correspondant au numéro de personne est retrouvé dans la colonne F
- Sheets.Add Count:=1, after:=Worksheets(Worksheets.Count) 'Création d'une feuille par num de personne
- ActiveSheet.Name = C.Value 'donne à la feuille le nom du sujet
- Range("F3" ).Select 'Selectionne F3 de la feuille créée pour l'individu
- ActiveCell.Paste 'Coller les valeurs des lignes copiées pour chaque personne
- End If
- Next NS
- End If
- Next C
-
- '==> la partie d'après fonctionne bien aussi
- 'copier coller de la première ligne dans chaque nouvelle feuille
- Dim F As Variant
- a = Application.Sheets.Count ' compte le nombre de feuille
-
- For F = 1 To a
- If Sheets(F).Name <> "FeuillesPropres" Then
- Sheets("FeuillesPropres" ).Rows(1).Copy Sheets(F).Rows(1)
- End If
- Next
- End Sub
|
---------------
Annye
|