copie de feuille

Sub azerty()
[COLOR=Green] 'adapter le nom des feuilles
' en colonne A
' chemin et nom de fichiers:
'ex: C:\Temp\test.Xls[/COLOR]
Dim swbk As Workbook
[B]Dim r
Dim i As Long[/B]
r = Range("A65000").End(xlUp).Row
[B]i = 1[/B]
For i = 1 To r
Application.DisplayAlerts = False
Sheets(1).Select
Set swbk = Workbooks.Open(Filename:=Range("A" & i).Value)
swbk.Sheets(1).Copy After:=Workbooks("nouveau classeur.xls").Sheets(2)
swbk.Close SaveChanges:=False
Sheets(1).Select
Next i
End Sub

Sub recopie_v2bis()
[COLOR=SeaGreen]'Déclarations des variables[/COLOR]
Dim swbk As Workbook: Dim DWk As Workbook
Dim r As Long: Dim i As Long: Dim rep
[COLOR=SeaGreen]'/////////////////
'Définition du classeur de destination des recopies 
[/COLOR]Set DWk = ThisWorkbook[COLOR=SeaGreen] ' ici le classeur actif[/COLOR]
[COLOR=SeaGreen]'désactivation du rafraichissement de l'affichage[/COLOR]
Application.ScreenUpdating = False
r = DWk.Sheets("liste").Range("A65000").End(xlUp).Row
i = 1
For i = 1 To r
[COLOR=SeaGreen]'ouverture des classeurs de la liste[/COLOR]
Set swbk = _
Workbooks.Open(Filename:=DWk.Sheets("liste").Range("A" & i).Value)
swbk.Sheets(1).Copy After:=Workbooks("nouveau classeur.xls").Sheets("liste")
[COLOR=SeaGreen]'ici on renomme la feuille recopiée avec le nom du classeur source suivi
'du nom de la feuille copiée[/COLOR]
ActiveSheet.Name = _
swbk.Name & "_" & swbk.Sheets(1).Name
swbk.Close SaveChanges:=False
Next i
[COLOR=SeaGreen]'ici le petit plus  ;-)[/COLOR]
rep = _
MsgBox("La recopie des feuilles est achevée, voulez-vous retourner sur la feuille liste?", _
vbInformation + vbYesNo, "Message")
If rep = 6 Then
DWk.Sheets("liste").Select
Else
Cancel = True
End If
'[COLOR=SeaGreen]réactivation du rafraichissement écran[/COLOR]
Application.ScreenUpdating = True
End Sub

Sub recopie_v3()
'Déclarations des variables
Dim swbk As Workbook: Dim DWk As Workbook
Dim r As Long: Dim i As Long: Dim rep
'/////////////////
'Définition du classeur de destination des recopies
Set DWk = ThisWorkbook ' ici le classeur actif
'désactivation du rafraichissement de l'affichage
Application.ScreenUpdating = False
r = DWk.Sheets("liste").Range("A65000").End(xlUp).Row
i = 1
For i = 1 To r
'ouverture des classeurs de la liste
Set swbk = _
Workbooks.Open(Filename:=DWk.Sheets("liste").Range("A" & i).Value, [B]UpdateLinks:=False,[/B] [B]ReadOnly:=True[/B])
swbk.Sheets(1).Copy After:=DWk.Sheets("liste")
'ici on renomme la feuille recopiée avec le nom du classeur source suivi
'du nom de la feuille copiée
ActiveSheet.Name = _
swbk.Name & "_" & swbk.Sheets(1).Name
swbk.Close SaveChanges:=False
Next i
'ici le petit plus  ;-)
rep = _
MsgBox("La recopie des feuilles est achevée, voulez-vous retourner sur la feuille liste?", _
vbInformation + vbYesNo, "Message")
If rep = 6 Then
DWk.Sheets("liste").Select
Else
Cancel = True
End If
'réactivation du rafraichissement écran
Application.ScreenUpdating = True
End Sub

Sub test()
Dim x As String
Dim y As String
Dim z As String
x = "C:\bilans\bilan année AAAA\bilan-entité-numéro d'entité.xls"
y = StrReverse(Left(StrReverse(x), InStr(1, StrReverse(x), "-") - 1))
z = Replace(y, ".xls", vbNullString)
MsgBox y
MsgBox z
End Sub

Sub recopie_v4()
'Déclarations des variables
Dim swbk As Workbook: Dim DWk As Workbook
Dim r As Long: Dim i As Long: Dim rep
Dim nf As String
'/////////////////
'Définition du classeur de destination des recopies
Set DWk = ThisWorkbook ' ici le classeur actif
'désactivation du rafraichissement de l'affichage
Application.ScreenUpdating = False
r = _
DWk.Sheets("liste").Range("A65000").End(xlUp).Row
i = 1
For i = 1 To r
'ouverture des classeurs de la liste
Set swbk = _
Workbooks.Open(Filename:=DWk.Sheets("liste").Range("A" & i).Value, _
UpdateLinks:=False, _
ReadOnly:=True)
swbk.Sheets(1).Copy After:=DWk.Sheets("liste")
'ici on renomme la feuille recopiée
'avec le nom du classeur source suivi
'du nom de la feuille copiée
'ActiveSheet.Name = _
'swbk.Name & "_" & swbk.Sheets(1).Name
nf = _
Replace(StrReverse(Left(StrReverse(swbk.Name), _
InStr(1, StrReverse(swbk.Name), "-") - 1)), ".xls", vbNullString)
ActiveSheet.Name = nf & "_" & swbk.Sheets(1).Name
swbk.Close SaveChanges:=False
Next i
'ici le petit plus  ;-)
rep = _
MsgBox("La recopie des feuilles est achevée." & Chr(13) _
& "Voulez-vous retourner sur la feuille liste?", _
vbInformation + vbYesNo, "Message")
If rep = 6 Then
DWk.Sheets("liste").Select
Else
Cancel = True
End If
'réactivation du rafraichissement écran
Application.ScreenUpdating = True
End Sub