Répartition des infos d'une feuille de données dan

Sub Bouton1_QuandClic()
Dim ws As Worksheet
Dim c As Range
Dim ws1 As Worksheet
Dim i As Byte

'initialise la variable ws1 comme etant l'objet feuille base
Set ws1 = Sheets('base')
effacefeuilles 'lance la procédure d'effacement des feuilles

Application.ScreenUpdating = False 'gele l'ecran

'pour chaque cellule de la colonne B de la feuille base
For Each c In ws1.Range('b2:b' & ws1.Range('b65536').End(xlUp).Row)
        'vérifie si la feuille existe à travers la fonction existefeuille
        If ExisteFeuille(c.Value) Is Nothing Then
                'si la feuille n'existe pas, la crée (sheets.add)
                With Sheets.Add
                        .Name = c.Value 'lui donne le nom du critere
                        .Move after:=Sheets(Sheets.Count) 'deplace la nouvelle feuille à la fin du classeur
                        'boucle sur les 3 colonnes (A,B et C) pour alimenter la nouvelle feuille
                        For i = 1 To 3
                                .Cells(1, i) = ws1.Cells(c.Row, i)
                        Next i
                End With
        Else
                'si la feuille existe
                With Sheets(c.Text)
                        'recherche la premiere ligne vide de la colonne A
                        derligne = .Range('a65536').End(xlUp).Row + 1
                        'boucle pour alimenter les données
                        For i = 1 To 3
                                .Cells(derligne, i) = ws1.Cells(c.Row, i)
                        Next i
                End With
        End If
Next c

'sélectionne la feuille Base
ws1.Select
Application.ScreenUpdating = True 'dégèle l'ecran
End Sub

Cliquez pour agrandir...