Discussion :

[Annyie]

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 vous envoie le fichier avec la macro !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
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