Copier plusieurs onglets vers un autre classeur

Bonjour

Tous les mois je reçois un classeur qui doit alimenter un fichier de travail.

Ces deux classeurs comportent 20 onglets. Les données doivent être rapatriées à la suite des données du mois précédent.

Pour éviter d'écrire 20 fois la même action, je cherche à faire une boucle : copier les données de l'onglet "Bordeaux" (classeur source) vers l'onglet "Bordeaux" du classeur destination. Idem pour Clermont, Dijon, .....

Voici ce que j'ai écris (je m'excuse par avance d'agresser vos yeux) :

Sub Importation_tous_ctxt()

Application.ScreenUpdating = False

Workbooks.Open Filename:= _

"N:\DNMAC\Pole Pilotage\Pilotage controle\25_Analyse PCC\Stats\Requêtes\1_Caisses\2019\Nouveau format\STATS_QUALITE_PCC_ATT DP_MENSUEL_Caisses.xlsx" _

, Notify:=False

Sheets("Bordeaux").Select

Range("C6:L6").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

Windows("test_toutes_caisses.xlsm").Activate

Sheets("Bordeaux").Select

Range("A65536").End(xlUp).Offset(1, 0).Select

ActiveSheet.Paste

Application.CutCopyMode = False

Windows("STATS_QUALITE_PCC_ATT DP_MENSUEL_Caisses.xlsx").Activate

Sheets("Clermont").Select

Range("C6:L6").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

Windows("test_toutes_caisses.xlsm").Activate

Sheets("Clermont").Select

Range("A65536").End(xlUp).Offset(1, 0).Select

ActiveSheet.Paste

Application.CutCopyMode = False

'....... ainsi de suite pour les 20 villes

Windows("STATS_QUALITE_PCC_ATT DP_MENSUEL_Caisses.xlsx").Activate

ActiveWindow.Close

Application.ScreenUpdating = True

End Sub

Je vous remercie pour votre aide, car j'en ai grandement besoin.

Bonjour Adlsn, bonjour le forum,

Peut-être comme ça :

Sub Importation_tous_ctxt_2()
Dim CS As Workbook
Dim CD As Workbook
Dim OS As Worksheet
Dim OD As Worksheet
Dim PL As Range

Application.ScreenUpdating = False
Set CD = ThisWorkbook
Workbooks.Open Filename:= _
"N:\DNMAC\Pole Pilotage\Pilotage controle\25_Analyse PCC\Stats\Requêtes\1_Caisses\2019\Nouveau format\STATS_QUALITE_PCC_ATT DP_MENSUEL_Caisses.xlsx" _
, Notify:=False
Set CS = ActiveWorkbook
For Each OS In CS.Worksheets
    Set OD = CD.Worksheets(OS.Name)
    OS.Range(OS.Range("C6:L6"), OS.Range("C6:L6").End(xlDown)).Copy OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
Next OS
CS.Close False
Application.ScreenUpdating = True
End Sub

Bonjour ThauTheme,

Merci pour cette réponse rapide.

Il y un blocage au niveau de la ligne : Set OD = CD.Worksheets(OS.name)

Dois-je définir le "name" quelque part ?

Il faut peut être préciser le nom des onglets.

Merci

A.

Re,

En fait le code dit :

For Each OS In CS.Worksheets 'boucle sur tous les onglets OS du classeur source
    Set OD = CD.Worksheets(OS.Name) 'définit l'onglet destination (onglet portant le même nom dans le classeur destination)

Si ça plante là, cela signifie que le nom des onglets n'est pas strictement identique dans les deux classeurs...

D'accord

En effet j'ai des onglets non utiles à la fin. Ils ne se retrouvent pas dans le classeur de destination.

C'est parfait, tout fonctionne !!

Je peux poursuivre le développement.

Un grand merci,

Bonne fin de journée

Re,

Un code avec gestion des erreurs :

Sub Importation_tous_ctxt_2()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim PL As Range

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
'ouvre le fichier
Workbooks.Open Filename:= _
"N:\DNMAC\Pole Pilotage\Pilotage controle\25_Analyse PCC\Stats\Requêtes\1_Caisses\2019\Nouveau format\STATS_QUALITE_PCC_ATT DP_MENSUEL_Caisses.xlsx" _
, Notify:=False
Set CS = ActiveWorkbook 'définit le classeur source CS
For Each OS In CS.Worksheets 'boucle sur tous les onglet OS du classeur source CS
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set OD = CD.Worksheets(OS.Name) 'définit l'onglet destination OD (génère une erreur si cet onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        GoTo suite 'va à l'étiquette suite
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    'copier/coller
    OS.Range(OS.Range("C6:L6"), OS.Range("C6:L6").End(xlDown)).Copy OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
suite: 'étiquette
On Error GoTo 0 'annule la gestion des erreurs
Next OS 'prochain onglet de la boucle
CS.Close False 'ferme le classeur source sans enregistrer
Application.ScreenUpdating = True 'afficheles rafraîchissements d'écran
End Sub