Copier / Coller données de plusieurs feuilles sur une feuille [Résolu/Fermé]

Signaler
Messages postés
143
Date d'inscription
vendredi 29 mai 2015
Statut
Membre
Dernière intervention
5 septembre 2020
-
Messages postés
2200
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
3 mars 2021
-
Bonjour,


Dans un classeur j'ai 3 feuilles qui contiennent chacune un TCD (qui s'étend de la colonne B à la colonne T). Mes feuilles se nomment AnalyseX, AnalyseY, AnalyseZ.
Je voudrais pouvoir copier/coller les 3 TCD les uns à la suite des autres sur une quatrième feuille : Détail.
J'ai repris un code que l'on m'avait donné sur ce forum pour copier/coller des données contenu dans plusieurs classeurs, et j'essaye de l'adapter à mon nouveau besoin.
Cependant, je ne suis pas très douée en VBA, du coup je n'arrive pas à adapter le code pour qu'il puisse copier la deuxième feuille une fois qu'il a fini de copier la première et ainsi de suite.
Voici ce que j'ai pu faire :
Option Explicit

Sub Compiler_BaT()
Dim DL As Integer, LigVid As Long, Tampon
Dim Plage As Range

Application.ScreenUpdating = False
With Sheets("Détail")
Set Plage = Range(.Cells(3, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 20))
Plage.ClearContents
End With
With Sheets("AnalyseX")
DL = .Columns("B:T").Find(what:="*", searchdirection:=xlPrevious).Row
Tampon = .Range("B6:J" & DL)
End With
With Sheets("Detail")
LigVid = .Columns("B:T").Find(what:="*", searchdirection:=xlPrevious).Row + 1
Cells(LigVid, "B").Resize(UBound(Tampon), 19) = Tampon
End With
End Sub


Et voici le code que l'on m'a donné qui permet de faire un copier/coller de plusieurs classeurs:
Option Explicit
'------
Sub compiler_BaN()
Dim Chemin As String, Fich As String
Dim Derlig As Integer, Ligvid As Long, Tampon

'fige le défilement de l'écran
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Synthèse Globale").Range("B2:N10000").ClearContents

Chemin = ThisWorkbook.Path
'se déplace dans le dossier de travail
Fich = Dir(Chemin & "\classeur" & "*.xlsm")
While Fich <> ""
'ouverture d'un classeurX.xlsm
Workbooks.Open Filename:=Chemin & "\" & Fich 'ouvre le classeur
With Sheets("saisie")
Derlig = .Columns("B:N").Find(what:="*", searchdirection:=xlPrevious).Row
Tampon = .Range("B2:N" & Derlig) 'mémorise les données à compiler dans Base de données
End With
Workbooks(Fich).Close
'restitution
With ThisWorkbook.Sheets("Synthèse Globale")
Ligvid = .Columns("B:N").Find(what:="*", searchdirection:=xlPrevious).Row + 1
Cells(Ligvid, "B").Resize(UBound(Tampon), 13) = Tampon
End With
'affecte le fichier suivant (utilisation du joker " * " )
Fich = Dir
Wend

Sheets("Synthèse Globale").Activate
MsgBox "compilation terminée"
End Sub


Si quelqu'un peu m'aider à l'adapter .. Merci beaucoup

3 réponses

Messages postés
2200
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
3 mars 2021
319
Bonjour
Essayez ceci
Private LigVid As Long
Private DL As Integer
Private Tampon

Sub Compiler_BaT()
    Application.ScreenUpdating = False
    On Error Resume Next
    With Sheets("Détail")
        Cells.ClearContents
    End With
    With Sheets("AnalyseX")
        DL = .Columns("B:T").Find(what:="*", searchdirection:=xlPrevious).Row
        Tampon = .Range("B6:J" & DL)
    End With
    Recopie
    With Sheets("AnalyseY")
        DL = .Columns("B:T").Find(what:="*", searchdirection:=xlPrevious).Row
        Tampon = .Range("B6:J" & DL)
    End With
    Recopie
    With Sheets("AnalyseZ")
        DL = .Columns("B:T").Find(what:="*", searchdirection:=xlPrevious).Row
        Tampon = .Range("B6:J" & DL)
    End With
    Recopie
End Sub

Sub Recopie()
    On Error Resume Next
    With Sheets("Détail")
        LigVid = .Columns("B:T").Find(what:="*", searchdirection:=xlPrevious).Row + 1
        If LigVid = 0 Then LigVid = 1
        Cells(LigVid, "B").Resize(UBound(Tampon), 19) = Tampon
    End With
End Sub

Attention au nom donné à la feuille "Détail" (avec ou sans accent, ici j'ai mis l'accent).
Bonne journée
Cdlt
Messages postés
143
Date d'inscription
vendredi 29 mai 2015
Statut
Membre
Dernière intervention
5 septembre 2020

Bonjour Frenchie,

Merci pour ton code !

Petite question, mon besoin a encore un peu évolué ...
J'aimerais copier ces trois TCD contenu dans les feuille AnalyseX, AnalyseY, AnalyseZ, du classeur Analyse Produit. Et les coller dans la feuille "Base Produit", du classeur "Analyse Client". Les deux classeurs "Analyse Produit" et "Analyse Client" font parti du même fichier.

Comment pourrais je procéder ?

Merci pour ton aide
Messages postés
2200
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
3 mars 2021
319
Essayez
Private LigVid As Long
Private DL As Integer
Private Tampon
Private DossierClient
Private DossierProd

Sub Compiler_BaT()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    DossierProd = ThisWorkbook.Name
    Chemin = ThisWorkbook.Path
    'se déplace dans le dossier de travail
    DossierClient = Dir(Chemin & "\" & "*.xlsm")
    'ouverture d'un classeurX.xlsm
    Workbooks.Open Filename:=Chemin & "\" & DossierClient 'ouvre le classeur
    With Sheets("Base Produit")
        Cells.ClearContents
    End With
    
    Windows(DossierProd).Activate
    With Sheets("AnalyseX")
        DL = [c1000000].End(xlUp).Row
        Tampon = .Range("c6:T" & DL)
    End With
    Recopie
    With Sheets("AnalyseY")
        DL = [c1000000].End(xlUp).Row
        Tampon = .Range("c6:T" & DL)
    End With
    Recopie
    With Sheets("AnalyseZ")
        DL = [c1000000].End(xlUp).Row
        Tampon = .Range("c6:T" & DL)
    End With
    Recopie
    Workbooks(DossierClient).Activate
End Sub

Sub Recopie()
    On Error Resume Next
    'restitution
    Windows(DossierClient).Activate
    With Windows(DossierClient).Sheets("Base Produit")
        LigVid = [c1000000].End(xlUp).Row + 1
        Cells(LigVid, 3).Resize(UBound(Tampon), 13) = Tampon
    End With
    Windows(DossierProd).Activate
End Sub

Cdlt
Messages postés
2200
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
3 mars 2021
319
Petit rectificatif
Private LigVid As Long
Private DL As Integer
Private Tampon
Private DossierClient
Private DossierProd

Sub Compiler_BaT()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    DossierProd = ThisWorkbook.Name
    Chemin = ThisWorkbook.Path
    'se déplace dans le dossier de travail
    DossierClient = Dir(Chemin & "\" & "*.xlsm")
    'ouverture d'un classeurX.xlsm
    Workbooks.Open Filename:=Chemin & "\" & DossierClient 'ouvre le classeur
    With Sheets("Base Produit")
        Cells.ClearContents
    End With
    
    Windows(DossierProd).Activate
    With Sheets("AnalyseX")
        DL = [B1000000].End(xlUp).Row
        Tampon = .Range("B6:T" & DL)
    End With
    Recopie
    With Sheets("AnalyseY")
        DL = [B1000000].End(xlUp).Row
        Tampon = .Range("B6:T" & DL)
    End With
    Recopie
    With Sheets("AnalyseZ")
        DL = [B1000000].End(xlUp).Row
        Tampon = .Range("B6:T" & DL)
    End With
    Recopie
    Workbooks(DossierClient).Activate
End Sub

Sub Recopie()
    On Error Resume Next
    'restitution
    Windows(DossierClient).Activate
    With Windows(DossierClient).Sheets("Base Produit")
        LigVid = [B1000000].End(xlUp).Row + 1
        Cells(LigVid, 3).Resize(UBound(Tampon), 13) = Tampon
    End With
    Windows(DossierProd).Activate
End Sub
Messages postés
143
Date d'inscription
vendredi 29 mai 2015
Statut
Membre
Dernière intervention
5 septembre 2020

Il y un petit souci. Je n'ai aucun message d'erreur, mais le copier/coller ne s'effectue pas. Par contre le classeur "Analyse Produit" reste ouverte et les données de la feuille "Synthèse" sont effacées. je ne comprend pas, le nom de cette feuille n'est renseignées nulle part dans la macro...
Messages postés
2200
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
3 mars 2021
319
Bonsoir
Je ma suis basé à ce que vous avez écrit dans le post 2, petit rappel:
J'aimerais copier ces trois TCD contenu dans les feuille AnalyseX, AnalyseY, AnalyseZ, du classeur Analyse Produit. Et les coller dans la feuille "<gras>Base Produit", du classeur "Analyse Client". </gras> A aucun moment vous parlez d'une feuille synthèse.
Si rien ne s'est coller, c'est que je ne pointe pas sur la première ligne des TCD, dans le cas présent je commence à la ligne B6 . Remplacez B6 par la première cellule en haut à gauche du TCD .
Cdlt