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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
| Sub regroupe()
'regroupe les licenciés des <> feuilles dans la première feuille
Dim k As Integer, i As Integer, j As Integer
Dim nom_feuille As String
Dim ColCherchée As Range
Dim ColLicNum, ColNomNum, ColPréNum, ColPostNum, ColMailNum As Integer
Dim Tableau As Variant
Dim LicDictionnaire As Object
Set LicDictionnaire = CreateObject("Scripting.Dictionary")
'compte le nb de feuille dans le classeur
k = Sheets.Count
'pour chaque feuille (sauf la 1ère) on cherche le texte "N° le licence
'et on copie le texte dans la col C de la première feuille
For i = 2 To k
' on initialise les numéros de colonnes
ColLicNum = 0
ColNomNum = 0
ColPréNum = 0
ColPostNum = 0
ColMailNum = 0
Sheets(i).Activate
' on cherche la colonne du numéro de licencié
Set ColCherchée = Rows(1).Find("N° de licencié")
' si on la trouve
If Not ColCherchée Is Nothing Then
ColLicNum = ColCherchée.Column
ColCherchée.Activate
ActiveCell.Offset(1, 0).Select
End If
' on cherche la colonne du nom
Set ColCherchée = Rows(1).Find("NOM", Lookat:=xlWhole)
' si on la trouve
If Not ColCherchée Is Nothing Then ColNomNum = ColCherchée.Column
' on cherche la colonne du numéro de licencié
Set ColCherchée = Rows(1).Find("Prénom", Lookat:=xlWhole)
' si on la trouve
If Not ColCherchée Is Nothing Then ColPréNum = ColCherchée.Column
' on cherche la colonne du numéro de licencié
Set ColCherchée = Rows(1).Find("Poste")
' si on la trouve
If Not ColCherchée Is Nothing Then ColPostNum = ColCherchée.Column
' on cherche la colonne du numéro de licencié
Set ColCherchée = Rows(1).Find("Mail")
' si on la trouve
If Not ColCherchée Is Nothing Then ColMailNum = ColCherchée.Column
' Si on a trouvé la colonne de numéro de licence on met tous les éléments possibles dans un tableau
If ColLicNum <> 0 Then
Tableau = Range("A2:C" & LastRow(Sheets(i)))
'on va chercher les différents éléments dans le tableau et on les mets dans le dictionnaire
Dim Nom, Prénom, Poste, Mail As String
Dim LeLicencié As Licencié
With LicDictionnaire
For j = LBound(Tableau, 1) To UBound(Tableau, 1)
'Si le licencié existe dans le dictionnaire on le récupère
If .Exists(Tableau(j, ColLicNum)) Then
Set LeLicencié = .Item(Tableau(j, ColLicNum))
Else
Set LeLicencié = New Licencié
End If
LeLicencié.Numéro = Tableau(j, ColLicNum)
If ColNomNum <> 0 Then LeLicencié.Nom = Tableau(j, ColNomNum)
If ColPréNum <> 0 Then LeLicencié.Prénom = Tableau(j, ColPréNum)
If ColPostNum <> 0 Then LeLicencié.Poste = Tableau(j, ColPostNum)
If ColMailNum <> 0 Then LeLicencié.Courriel = Tableau(j, ColMailNum)
If Not .Exists(LeLicencié.Numéro) Then
'On ajoute un nouveau licencié si il n'existe pas
.Add LeLicencié.Numéro, LeLicencié
Else
'Mise à jour du licencié
Set .Item(LeLicencié.Numéro) = LeLicencié
End If
Next j
End With
End If
' Column.Activate
'On sélectionne tous les éléments et on les met dans le tableau Colonne
' Colonne = Range(Selection, Selection.End(xlDown))
Next i
'copie des licenciés dans la feuille Test
Sheets("Bilan").Select
Dim StrKey As Variant
Dim n As Integer
n = 2
For Each StrKey In LicDictionnaire.Keys()
Range("A" & n).Value = LicDictionnaire(StrKey).Nom
Range("B" & n).Value = LicDictionnaire(StrKey).Prénom
Range("C" & n).Value = LicDictionnaire(StrKey).Numéro
Range("D" & n).Value = LicDictionnaire(StrKey).Poste
Range("F" & n).Value = LicDictionnaire(StrKey).Courriel
n = n + 1
Next
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function |
Copier automatiquement des cellules de plusieurs feuilles dans une autre
Répondre avec citation
Envoyé par parmi
. Si ce message est résolu, cliquez sur 
.
Partager