Sub Copie()
Transfert 3
Transfert 6
End Sub
Sub Transfert(col As Integer)
Set feuille = ActiveSheet
Set r = feuille.Range(Cells(1, col), Cells(65000, col).End(xlUp))
Application.ScreenUpdating = False
For Each c In r
fichier = "E:\Kk\Temp\" & c.Value & ".xls" 'xls?, xlsm?, xlsx?
If Dir(fichier) <> "" Then
Workbooks.Open fichier
With ActiveWorkbook
feuille.Copy After:=.Sheets(Sheets.Count)
.Close True
End With
End If
Next
Application.ScreenUpdating = True
End Sub