Option Explicit
Sub FusionFeuilles()
Dim i As Long, T() As Variant
Application.ScreenUpdating = False
If shRecap.FilterMode Then shRecap.ShowAllData
shRecap.Cells.Clear
' En-Tête
For i = 1 To Worksheets.Count
If Worksheets(i).Name <> shRecap.Name And _
Worksheets(i).Name <> shMrc.Name And _
Worksheets(i).Name <> Feuil1.Name Then
With Worksheets(i)
T = .Range("A1:G1").Value
shRecap.Range("A1").Resize(UBound(T, 1), UBound(T, 2)) = T
End With
Exit For
End If
Next i
' Données
For i = 1 To Worksheets.Count
If Worksheets(i).Name <> shRecap.Name And _
Worksheets(i).Name <> shMrc.Name And _
Worksheets(i).Name <> Feuil1.Name Then
With Worksheets(i)
If .FilterMode Then .ShowAllData
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
If LastRow > 1 Then
T = .Range("A2:G" & .Range("A" & Rows.Count).End(xlUp).Row).Value
shRecap.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(T, 1), UBound(T, 2)) = T
End If
End With
End If
Next i
With shRecap
.Activate
.Range("K1").Select
End With
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Erase T
Application.ScreenUpdating = True
End Sub