1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
   | Sub toto2()
    Dim feuille As Worksheet
    Dim nomPersonne As String
 
    For Each feuille In Worksheets
        nomPersonne = feuille.Name
        Dim plage As Range
        Dim cellule As Range
 
        Set plage = Worksheets("Feuil1").Range("B8", Worksheets("Feuil1").Range("B8").End(xlDown))
        Dim nbLigne As Integer
        nbLigne = 1
        For Each cellule In plage
            If cellule.Value = nomPersonne Then
                Worksheets("Feuil1").Range(cellule, cellule.End(xlToRight)).Copy Destination:=Sheets(feuille.Name).Range(Sheets(feuille.Name).Range("A1").Offset(nbLigne, 0).Address)
                nbLigne = nbLigne + 1
            End If
        Next cellule
    Next feuille
End Sub | 
Partager