Copier / Coller données de plusieurs feuilles sur une feuille

Résolu
ti_mouton Messages postés 153 Statut Membre -  
Frenchie83 Messages postés 2254 Statut Membre -
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

  1.
    Frenchie83 Messages postés 2254 Statut Membre 339
     
    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
    0
    1. ti_mouton Messages postés 153 Statut Membre
       
      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
      0
  2. Frenchie83 Messages postés 2254 Statut Membre 339
     
    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
    0
  3. Frenchie83 Messages postés 2254 Statut Membre 339
     
    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
    0
    1. ti_mouton Messages postés 153 Statut Membre
       
      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...
      0
    2. Frenchie83 Messages postés 2254 Statut Membre 339
       
      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
      0

Discussions similaires

dessin avec symbole clavier
JSS -
Adraen -

79 réponses
Copier coller impossible
coulondou -
jeanmarc -

43 réponses
Copier coller une image de Google sur Macbook
orianepark -
dede74000 -

1 réponse