Sub Test()
'Déclarations ===================================
Dim F As Worksheet, F_D As Worksheet
Dim Plage As Range
Dim Tab_V() As String, X As Long, Y As Long, Flag As Boolean
'MEI ============================================
Set F_D = Sheets("Tous")
'suppression filtrage ---------------------------
With F_D
If .FilterMode Then .ShowAllData
'Création ligne de titre ------------------------
If .[A1] <> "A" Then
.Rows(1).Insert
.[A1] = "A"
End If
'Définition de la plage -------------------------
Set Plage = .[A1].CurrentRegion
'Recherche des noms d'onglets ===================
'définition des noms ----------------------------
.Columns(1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
X = .UsedRange.Rows.Count + 10
Plage.Copy .Cells(X, "A")
ReDim Tab_V(1 To .Cells(Rows.Count, "A").End(xlUp).Row - X)
For Y = 1 To UBound(Tab_V)
Tab_V(Y) = .Cells(X + Y, "A")
Next Y
'RAZ --------------------------------------------
.Range(.Rows(X), .Rows(X + Y)).Delete
End With
'Copie des valeurs ==============================
For X = 1 To UBound(Tab_V)
'pour chaque valeur de Tab_V
Flag = True
For Each F In ThisWorkbook.Sheets
If F.Name Like Tab_V(X) Then
Flag = False
Exit For
End If
Next F
'Création d'une nouvelle feuille -----------
If Flag Then
ThisWorkbook.Sheets.Add after:=Sheets(ThisWorkbook.Worksheets.Count)
ActiveSheet.Name = Tab_V(X)
Set F = Sheets(Tab_V(X))
End If
'Copie des valeurs -------------------------
If F_D.FilterMode Then F_D.ShowAllData
Y = F.Cells(Rows.Count, "A").End(xlUp).Row
If Range("A" & Y) = "" Then Y = Y + 1
Plage.AutoFilter field:=1, Criteria1:=Tab_V(X)
Plage.Copy F.Range("A" & Y)
'nettoyage valeurs ajoutées ----------------
If F.Range("A" & Y) = "" Then F.Rows(Y).Delete
If F.Range("A" & Y) = "A" Then F.Rows(Y).Delete
Next X
End Sub
