Copier des tableaux d'autres fichiers Excel de hauteurs différentes

Question

Je souhaite copier sur le "Classeur.xlsm" en A1 les tableaux du "ClasseurA.xlsm" situés sur la feuil2 et en AA1 les tableaux du "ClasseurB.xlsm" situés sur la feuil2. Dans un autre fichier, je me sers de cette formule (Sheets("XXXX").Cells(33, 4).Value = Sheets("YYYY").Cells(3, 15).Value)) pour copier coller des valeurs de tableaux. Pouvez-vous m'aider à adapter cette formule à mon cas afin de comprendre le fonctionnement. Merci d'avance ...

ThauThème · Answer

Bonsoir Tisajeff, bonsoir le forum,

Code à placer dans le classeur destination classeur.xlms. Si tous les fichiers se trouvent dans le même dossier que ce classeur destination, pas besoin de les ouvrir. Ouvre juste classeur.xlsm et lance le code. Sinon ouvre les trois classeurs puis lance le code (ou donne-nous le chemin d'accès de chaque classeur et on modifiera le code en fonction).

Le code :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)

Set CD = ThisWorkbook 'définit la classeur destination CD
CA = CD.Path & "\" 'définit le chemin d'accès CA
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD

'classeura
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CS = Workbooks("classeura.xlsm") 'définit le classeur source CS (génère une erreur si ce classeur n'est pas ouvert)
If Err > 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Set CS = Workbooks.Open(CA & "classeura.xlsm") 'définit le classeur source en l'ouvrant
End If 'fin de la condition
On Error GoTo 0 'fin de la gestion des erreurs
Set OS = CS.Worksheets("Feuil2") 'définit l'onglet source OS
OS.UsedRange.Copy OD.Range("A1") 'copie la plage éditée de l'onglet source et la colle dans A1 de l'onglet destinatoin
CS.Close False 'ferme le classeur source sans enregistrer

'classeurb
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CS = Workbooks("classeurb.xlsm") 'définit le classeur source CS (génère une erreur si ce classeur n'est pas ouvert)
If Err > 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Set CS = Workbooks.Open(CA & "classeurb.xlsm") 'définit le classeur source en l'ouvrant
End If 'fin de la condition
On Error GoTo 0 'fin de la gestion des erreurs
Set OS = CS.Worksheets("Feuil2") 'définit l'onglet source OS
OS.UsedRange.Copy OD.Range("AA1") 'copie la plage éditée de l'onglet source et la colle dans AA1 de l'onglet destinatoin
CS.Close False 'ferme le classeur source sans enregistrer
End Sub

ThauThème · Answer

Re, Je ne comprends pas, le code ne traitera, quels que soient les fichiers ouverts, que classeura.xlsm et classeurb.xlsm ... Tu as parfaitement adapté le code mais je l'ai un peu remis en ordre ...