'### A adapter ###
Const LIG_DEPART As Long = 13
'#################
Sub FusionFeuilles()
Dim Titres
Dim Exclus
Dim S As Worksheet
Dim S2 As Worksheet
Dim R As Range
Dim i&
Dim j&
Dim bool As Boolean
Dim dest&
'### A adapter (feuilles exclues, noms des titres) ###
Exclus = Array("Archive", "Recap", "Expo")
Titres = Array("Type", "Version", "Test", "Forme", "GGR", "FFR", "SSER", "Date", "Qui")
'#####################################################
dest& = 1
Set S = Sheets.Add(before:=Sheets(1))
For i& = 2 To ActiveWorkbook.Worksheets.Count - 1
Set S2 = ActiveWorkbook.Worksheets(i&)
bool = False
For j& = LBound(Exclus) To UBound(Exclus)
If LCase(Exclus(j&)) = LCase(Mid(S2.Name, 1, Len(Exclus(j&)))) Then
bool = True
Exit For
End If
Next j&
If Not bool Then
Set R = S2.Range(S2.Cells(LIG_DEPART, 1), _
S2.Cells(S2.[a65536].End(xlUp).Row, UBound(Titres) + 1))
R.Copy
S.Paste Destination:=S.Range("a" & dest& & "")
dest& = dest& + R.Rows.Count
End If
Next i&
For i& = dest& - 1 To 1 Step -2
S.Rows(i&).Delete
Next i&
S.Rows(1).Insert
S.Range(Cells(1, 1), Cells(1, UBound(Titres) + 1)) = Titres
End Sub