Option Explicit
Sub toto() '
'La procédure utilise deux plages nommées de cette feuille :
' [colNoms] qui est la colonne contenant le champ «NOM_PRENOM» (A:A dans ce classeur) ;
' [celOrigine] qui est la première cellule susceptible de revcevoir des données (G3 dans ce classeur).
'
Dim lO&, cO&, cNoms&, i&, nom&, dat&, ong&, idNom(), idDat(), nomsMois(), feuille As Worksheet '
With Me '«Me» fait référence à la feuille contenant ce code.
'Liste des onglets à traiter. Les noms d'onglet doivent être exactement ceux de la liste.
'(À corriger si vous voulez éviter la faute d'orthographe dans "Fevrier".)
nomsMois = Array(.Name, "Janvier", "Fevrier", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre") '
'Tous les onglets concernés doivent avoir la même structure que celle de cette feuille. (Dans ce classeur,
'champ «NOM_PRENOM» en colonne A, début des données en G3.)
lO = .[celOrigine].Row: cO = .[celOrigine].Column: cNoms = .[colNoms].Column '
'À partir de la colonne «cO», la ligne «lO - 1» de chaque onglet à traiter est supposée contenir toutes les dates
'correspondant à son nom, en ordre croissant. La dernière date est suivie d'une cellule vide.
'Relevé de la colonne «A». La liste des noms est supposée sans doublon.
idNom = .Cells(1, cNoms).Resize(.Cells(.Rows.Count, cNoms).End(xlUp).Row).Value '
'Relevé de la ligne «lO - 1».
idDat = .Cells(lO - 1, 1).Resize(1, .Cells(lO - 1, 1).End(xlToRight).Column).Value '
'
With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With '
'
'Effacement du contenu actuel.
If UBound(idNom, 1) > 2 And UBound(idDat, 2) > 2 Then .Range(.Cells(lO, cO), .Cells(UBound(idNom, 1), UBound(idDat, 2))).Clear '
'
'=== Ajout : petite boucle "technique" pour éviter que la plage «Range(Cells(lO - 1, 1), Cells(lO - 1, cO - 1))» ait une cellule vide.
On Error Resume Next '
For ong = 0 To UBound(nomsMois) 'Énumérations des feuilles
Set feuille = Worksheets(nomsMois(ong)) '
If Err.Number = 0 Then 'Si le nom d'onglet de la feuille est dans la liste «nomsMois»...
For i = 1 To cO - 1 '
If Len(feuille.Cells(lO - 1, i).Value) = 0 Then feuille.Cells(lO - 1, i).Value = " " '
Next '
End If '
Next '
On Error GoTo 0 '
Set feuille = Nothing '
'=== Fin de l'ajout.
'
For nom = lO To UBound(idNom, 1) 'Énumération des noms.
For dat = cO To UBound(idDat, 2) 'Énumération des dates.
If Day(idDat(1, dat)) = 1 Then 'si la date courante est le premier jour d'un mois...
For ong = 1 To Worksheets.Count '...alors énumérations des feuilles
If nomsMois(Month(idDat(1, dat))) = Worksheets(ong).Name Then 'Si le nom d'onglet de la feuille est dans la liste «nomsMois»...
For i = lO To Worksheets(ong).Cells(Worksheets(ong).Rows.Count, cNoms).End(xlUp).Row '...énumération des noms dans l'onglet.
If idNom(nom, 1) = Worksheets(ong).Cells(i, cNoms).Value Then 'Si le nom de l'onglet est le nom indexé par 'nom'...
If idDat(1, dat) = Worksheets(ong).Cells(lO - 1, cO).Value Then '... et si la date en «Cells(lO - 1, cO)» dans l'onglet
'est la date indexée par 'dat', copie de la ligne indexée par 'i' de l'onglet vers la ligne indexée par 'nom' dans le récapitulatif.
Worksheets(ong).Cells(i, cO).Resize(1, Worksheets(ong).Cells(lO - 1, 1).End(xlToRight).Column - cO + 1).Copy Destination:=.Cells(nom, dat) '
End If '
Exit For '
End If '
Next '
Exit For '
End If '
Next '
End If '
Next '
Next '
'
With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With '
'
End With '
End Sub '
