Dim pl As Range
Dim F1
Dim xCpt
xCpt = 0
Set pl = Sheets("Z_Art_Stock").Range("Base")
pl.Name = "Base"
For Each sh In Sheets
F1 = Array("Z_Art_Stock", "BD")
If sh.Name <> F1(xCpt) Then
' If sh.Name <> "Z_Art_Stock" Then ' ok
With sh
.[K1] = "Mag1"
.[K2] = sh.Name
pl.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.[K1:K2], CopyToRange:=.Range("A1:J1"), Unique:=False
.[K1:K2].ClearContents
End With
End If
xCpt = xCpt + 1
Next sh