Option Explicit
Sub Assemble()
Dim Classeur As String
Dim Chemin As String
Dim LigneMax As Long, Position As Long
Dim LigneFin As Long, Tourne As Long
Dim Coupure As Long
LigneFin = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For Tourne = 1 To LigneFin
Coupure = InStrRev(Sheets("Liste").Range("A" & Tourne), "\")
Chemin = Left(Sheets("Liste").Range("A" & Tourne), Coupure)
Classeur = Mid(Sheets("Liste").Range("A" & Tourne), Coupure + 1)
If Classeur <> ThisWorkbook.Name And Right(Classeur, 5) = ".xlsx" Then
Workbooks.Open Filename:=Chemin & Classeur, ReadOnly:=True
LigneMax = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If LigneMax > 3 Then
Position = ThisWorkbook.Worksheets("Base").Range("A" & Rows.Count).End(xlUp).Row + 1
ActiveSheet.Range("A3:K" & LigneMax).Copy Destination:=ThisWorkbook.Worksheets("Base").Range("A" & Position)
End If
Workbooks(Classeur).Close False
End If
Next Tourne
End Sub