Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim RC As Worksheet 'déclare la variable RC (onglet RéCap)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI (LIgne)
Set RC = Sheets("Récap") 'définit l'onglet RC
For Each O In Sheets 'boucle 1 : sur tous les onglets O du classeur
Select Case O.Name 'agit en fontion du nom de l'onglet
Case "Janvier"
COL = 3 'définit la colonne COL
Case "Février"
COL = 15 'définit la colonne COL
Case "Mars"
COL = 27 'définit la colonne COL
Case "Avril"
COL = 39 'définit la colonne COL
Case "Mai"
COL = 51 'définit la colonne COL
Case "Juin"
COL = 63 'définit la colonne COL
Case "Juillet"
COL = 75 'définit la colonne COL
Case "Août" 'attention j'ai renommé lónglet avec l'accent (û)
COL = 87 'définit la colonne COL
Case "Septembre"
COL = 99 'définit la colonne COL
Case "Octobre"
COL = 11 'définit la colonne COL
Case "Novembre"
COL = 123 'définit la colonne COL
Case "Décembre"
COL = 135 'définit la colonne COL
Case "Recap"
GoTo suite 'va à l'étiquette "suite"
End Select 'fin de l'action en fonction du non de l'onglet
TV = O.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes du tableau des valeurs (en partant de la seconde)
Set R = RC.Columns("A").Find(TV(I, 1), , xlValues, xlWhole) 'définit la recherche R (Recherche dans la colonne A de Récap la valeur entière de TV(I,1))
If Not R Is Nothing Then 'condition : si au moins une occurrence est trouvée
LI = R.Row 'définit la ligne LI (ligne de la première occurrence trouvée)
Else 'sinon
LI = RC.Range("A" & Application.Rows.Count).End(xlUp).Row + 1 'définit la ligne LI (première ligne vide de la colonne A de Récap)
End If 'fin de la condition
RC.Cells(LI, 1).Value = TV(I, 1) 'place le nom dans la colonne A de Récap
RC.Cells(LI, 2).Value = TV(I, 2) 'place le prénom dans la colonne A de Récap
For J = 0 To 10 'boucle 3 : de 0 à 10
RC.Cells(LI, COL + J).Value = TV(I, J + 3) 'renvoie la donnée du tableau TV dans la colonne COL + J de Récap
Next J 'prochaine colonne de la boucle 3
Next I 'prochaine ligne de la boucle 2
suite: 'étiquette
Next O 'prochain onglet de la boucle 1
End Sub
' classeur
Dim Shd As Worksheet, ShR As Worksheet
Dim MonTab As Variant, Compt1 As Long
Sub copyData()
Dim Pas As Integer
Pas = 12 ' a modifier
Set ShR = Worksheets("Récap")
For Each Shd In Worksheets
Select Case Shd.Name
Case "Janvier"
MoisNom Shd, 3
Case "Février"
MoisNom Shd, (3 + Pas)
Case "Mars"
MoisNom Shd, (3 + 2 * Pas)
Case "Avril"
MoisNom Shd, (3 + 3 * Pas)
Case "Mai"
MoisNom Shd, (3 + 4 * Pas)
Case "Juin"
MoisNom Shd, (3 + 5 * Pas)
Case "Juillet"
MoisNom Shd, (3 + 6 * Pas)
Case "Aout"
MoisNom Shd, (3 + 7 * Pas)
Case "Septembre"
MoisNom Shd, (3 + 8 * Pas)
Case "Octobre"
MoisNom Shd, (3 + 9 * Pas)
Case "Novembre"
MoisNom Shd, (3 + 10 * Pas)
Case "Décembre"
MoisNom Shd, (3 + 11 * Pas)
End Select
Next Shd
End Sub
Private Function RechercheLigne(Nom As String, Prenom As String) As Long
RechercheLigne = 0
With ShR
Set Plg1 = .Range("A1:B" & .Range("a" & .Rows.Count).End(xlUp).Row)
MonTab = Plg1.Value
For Compt1 = LBound(MonTab, 1) To UBound(MonTab, 1)
If MonTab(Compt1, 1) = Nom And MonTab(Compt1, 2) = Prenom Then
RechercheLigne = Compt1
Exit Function
End If
Next Compt1
End With
End Function
Private Sub MoisNom(Shd As Worksheet, Colonne As Long)
Dim Cellule1 As Range, Plg1 As Range, Lig As Long
With Shd
For Each Cellule1 In .Range("a2:a" & .Range("a" & .Rows.Count).End(xlUp).Row)
Lig = RechercheLigne(CStr(Cellule1.Value), CStr(Cellule1.Offset(0, 1).Value))
If Lig = 0 Then 'ajout
Dl1 = ShR.Range("A" & Rows.Count).End(xlUp).Row + 1
ShR.Range("a" & Dl1) = Cellule1
ShR.Range("b" & Dl1) = Cellule1.Offset(0, 1)
Lig = Dl1
.Range(Cellule1.Offset(0, 2).Address(0, 0) & ":M" & Cellule1.Row).copy _
Destination:=ShR.Cells(Lig, Colonne)
Else
.Range(Cellule1.Offset(0, 2).Address(0, 0) & ":M" & Cellule1.Row).copy _
Destination:=ShR.Cells(Lig, Colonne)
End If
Next Cellule1
End With
End Sub
If MonTab(Compt1, 1) = Nom And MonTab(Compt1, 2) = Prenom Then