Sub CopierPlagesEntreFichiers()
Dim CheminSource As String
Dim CheminDestination As String
Dim i As Integer
Dim ClasseurSource As Workbook
Dim ClasseurDestination As Workbook
Dim NomFichierSource As String
Dim NomFichierDestination As String
Dim Plage1 As Range
Dim Plage2 As Range
' ----------------------------------------------------
' À PERSONNALISER : Modifiez ces chemins de dossiers
' ----------------------------------------------------
CheminSource = "C:\VotreDossierSource\" ' Chemin où se trouvent FichierA1, FichierA2, etc.
CheminDestination = "C:\VotreDossierDestination\" ' Chemin où FichierB1, FichierB2 seront créés/mis à jour
' ----------------------------------------------------
' Assurez-vous que les chemins se terminent par un "\"
If Right(CheminSource, 1) <> "\" Then CheminSource = CheminSource & "\"
If Right(CheminDestination, 1) <> "\" Then CheminDestination = CheminDestination & "\"
' Boucle pour chaque fichier de 1 à 750
For i = 1 To 750
NomFichierSource = "FichierA" & i & ".xlsx" ' Assurez-vous de l'extension correcte (par exemple .xlsx, .xls)
NomFichierDestination = "FichierB" & i & ".xlsx" ' Assurez-vous de l'extension correcte
On Error Resume Next ' Gère les erreurs si un fichier n'est pas trouvé ou ne peut pas être ouvert
' Ouvre le fichier source
Set ClasseurSource = Workbooks.Open(CheminSource & NomFichierSource)
If Not ClasseurSource Is Nothing Then ' Vérifie si le fichier source a été ouvert avec succès
' Tente d'ouvrir le fichier de destination. S'il n'existe pas, il sera créé.
Set ClasseurDestination = Nothing ' Réinitialise l'objet
Set ClasseurDestination = Workbooks.Open(CheminDestination & NomFichierDestination)
If ClasseurDestination Is Nothing Then ' Le fichier de destination n'existe pas, on le crée
Set ClasseurDestination = Workbooks.Add
ClasseurDestination.SaveAs Filename:=CheminDestination & NomFichierDestination
End If
' S'assure que le fichier de destination est ouvert ou a été créé
If Not ClasseurDestination Is Nothing Then
' Copie la première plage (A1-C50)
' Assurez-vous que les noms de feuilles sont corrects si ce n'est pas "Sheet1"
Set Plage1 = ClasseurSource.Sheets("Feuil1").Range("A1:C50")
Plage1.Copy Destination:=ClasseurDestination.Sheets("Feuil1").Range("A1")
' Copie la deuxième plage (D3-F15)
Set Plage2 = ClasseurSource.Sheets("Feuil1").Range("D3:F15")
Plage2.Copy Destination:=ClasseurDestination.Sheets("Feuil1").Range("D3") ' Ou la destination souhaitée dans le fichier B
' Sauvegarde et ferme le fichier de destination
ClasseurDestination.Save
ClasseurDestination.Close SaveChanges:=False ' Le fichier est déjà sauvegardé
Else
MsgBox "Impossible d'ouvrir ou de créer le fichier de destination : " & NomFichierDestination, vbCritical
End If
' Ferme le fichier source
ClasseurSource.Close SaveChanges:=False
Else
MsgBox "Impossible d'ouvrir le fichier source : " & NomFichierSource, vbCritical
End If
On Error GoTo 0 ' Réactive la gestion normale des erreurs
Next i
MsgBox "L'opération de copie est terminée !", vbInformation
End Sub
