Sub Test()
Dim FeBase As Worksheet
Dim Fe As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim Ligne As Long
Set FeBase = Worksheets("Base")
'défini la plage de recherche sur la colonne A de la feuille "Base" à partir de A4
With FeBase: Set Plage = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
'parcours la plage
For Each Cel In Plage
'si la feuille n'existe pas, une erreur est générée
On Error Resume Next
Set Fe = Worksheets(Cel.Value)
'donc, création de la feuille avec le nom correspondant
If Err.Number <> 0 Then
Set Fe = Worksheets.Add(, Sheets(Sheets.Count))
Fe.Name = Cel.Value
Err.Clear
End If
'cherche la dernière ligne non vide en colonne A de la feuille en cours
With Fe: Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row: End With
'si elle est égale à 1 et que la cellule A1 est vide, inscrit les entêtes de colonnes
If Ligne = 1 And Fe.Cells(1, 1).Value = "" Then
Fe.Range(Fe.Cells(1, 1), Fe.Cells(1, 7)).Value = FeBase.Range(FeBase.Cells(3, 1), FeBase.Cells(3, 7)).Value
End If
'inscrit les valeurs dans la ligne vide située dessous (+1)
Fe.Range(Fe.Cells(Ligne + 1, 1), Fe.Cells(Ligne + 1, 7)).Value = FeBase.Range(Cel, Cel.Offset(, 6)).Value
Next Cel
End Sub