Sujet Précédent Sujet Suivant

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

Résolu/Fermé
ti_mouton Messages postés 143 Date d'inscription vendredi 29 mai 2015 Statut Membre Dernière intervention 5 septembre 2020 - Modifié par ti_mouton le 28/07/2015 à 12:22
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 - 30 juil. 2015 à 20:26
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
A voir également:

3 réponses

Réponse 1 / 3
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
30 juil. 2015 à 08:44
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
ti_mouton Messages postés 143 Date d'inscription vendredi 29 mai 2015 Statut Membre Dernière intervention 5 septembre 2020
30 juil. 2015 à 11:43
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
Réponse 2 / 3
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
30 juil. 2015 à 14:05
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
Réponse 3 / 3
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
30 juil. 2015 à 14:07
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
ti_mouton Messages postés 143 Date d'inscription vendredi 29 mai 2015 Statut Membre Dernière intervention 5 septembre 2020
30 juil. 2015 à 19:49
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
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
30 juil. 2015 à 20:26
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

Dessiner avec son clavier et avec des lettres
JSS -
Polodu33 -

78 réponses
Reporter valeur sur autre feuille avec critere
Otk168 -
via55 -

4 réponses
Feuille de score belote
nulleeninfo -
brucine -

7 réponses
feuille excel de gestion belote
SiFaSiLa -
frank -

2 réponses
Comment faire le signe de croix (chrétiens) ?
Chachaba -
BoeufDoux20 -

15 réponses