Copier/Coller des données de plusieurs feuille vers une autre feuille.

[ti_mouton]

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 le forum CCM 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

 

[Compte Supprimé 979]

Re : Copier/Coller des données de plusieurs feuille vers une autre feuille.

Bonjour,

Moins compliqué en code voici le miens à tester et/ou adapter

Sub CopieDsDetail()
  Dim Ind As Integer, DLigS As Long, DLigD As Long
  Dim Sht As Worksheet, TabS() As String
  ' Définir la liste des feuilles à copier
  TabS = Split("AnalyseX,AnalyseY,AnalyseZ", ",")
  ' Avec la feuille Détail
  With Worksheets("Détail")
    ' Pour chaque feuille du tableau
    For Ind = 0 To UBound(TabS)
      ' Définir la feuille à copier
      Set Sht = Worksheets(TabS(Ind))
      ' Trouver la dernière ligne du TCD
      DLigS = Sht.Range("B" & Rows.Count).End(xlUp).Row
      ' récupérer la dernière ligne de Détail
      DLigD = .Range("A" & Rows.Count).End(xlUp).Row
      If DLigD = 1 Then DLigD = 0
      ' Copier le tableau
      Sht.Range("B1:T" & DLigS).Copy Destination:=.Range("A" & DLigD + 1)
    Next Ind
  End With
End Sub

A+

 

[ti_mouton]

Re : Copier/Coller des données de plusieurs feuille vers une autre feuille.

Bonjour BrunoM45,

Tout d'abord merci pour ton aide. Je viens d'essayer d'adapter ton code à mon fichier, malheureusement je n'arrive pas à le faire fonctionner jusqu'au bout, il me copie bien le TCD de la premiere feuille AnalyseBLOCS, mais ensuite plus rien...

Sub CopieDsDetail()
   Dim Ind As Integer, DLigS As Long, DLigD As Long
   Dim Sht As Worksheet, TabS() As String
   ' Définir la liste des feuilles à copier
   TabS = Split("AnalyseBLOCS,AnalyseENV,AnalyseVOIRIES,AnalyseNEGOCE", ",")
   ' Avec la feuille Détail
   With Worksheets("GLOBAL")
     ' Pour chaque feuille du tableau
     For Ind = 0 To UBound(TabS)
       ' Définir la feuille à copier
       Set Sht = Worksheets(TabS(Ind))
       ' Trouver la dernière ligne du TCD
       DLigS = Sht.Range("B" & Rows.Count).End(xlUp).Row
       ' récupérer la dernière ligne de Détail
       DLigD = .Range("B" & Rows.Count).End(xlUp).Row
       If DLigD = 1 Then DLigD = 0
       ' Copier le tableau
       Sht.Range("B5:T" & DLigS).Copy Destination:=.Range("B" & DLigD + 1)
     Next Ind
   End With
 End Sub

Saurais tu me dire ce que j'ai mal renseigné ?

Merci

 

[ti_mouton]

Re : Copier/Coller des données de plusieurs feuille vers une autre feuille.

OUps j'ai parlé trop vite ! Tout marche très bien, je te prie de m'excuser. Merci beaucoup pour ton code !

Une dernière question si tu le veux bien, saurait il possible de recopier les TCD en valeur, sans les entêtes de colonnes qui se répètent à chaque fois ?

 

[Compte Supprimé 979]

Re : Copier/Coller des données de plusieurs feuille vers une autre feuille.

Re,

Ok, tu remplaces la ligne ci-dessous par celles qui suivent

'Sht.Range("B5:T" & DLigS).Copy Destination:=.Range("B" & DLigD + 1)
Sht.Range("B5:T" & DLigS).Copy
.Range("B" & DLigD + 1).PasteSpecial Paste:=xlPasteValues

A+

 

[ti_mouton]

Re : Copier/Coller des données de plusieurs feuille vers une autre feuille.

Oui ils commencent tous en B5. Le copier/coller marche très bien. Mon idée ensuite serait de pouvoir me servir de cette nouvelle base de données pour refaire un nouveau TCD, mais pour cela il faudrait que je puisse faire en sorte d'éviter que les entêtes de colonnes de mes TCD soient recopiées à chaque fois.

 

[ti_mouton]

Re : Copier/Coller des données de plusieurs feuille vers une autre feuille.

C'est parfait ! Merci beaucoup.
Tu vas me trouver exigente mais comment faire pour que les tableaux ne soient copier qu'à partir de la cellule B2 dans la feuille de destination ?
J'ai tenté de modifier la ligne .Range("B" & DLigD + 1).PasteSpecial Paste:=xlPasteValues
en .Range("B2" & DLigD + 1).PasteSpecial Paste:=xlPasteValues
Mais ce fût une catastrophe ...

 

[Compte Supprimé 979]

Re : Copier/Coller des données de plusieurs feuille vers une autre feuille.

Re,

Puisque j'ajoute 1 à la Dernière Ligne de Destination trouvée

Supprime tout simplement cette ligne

If DLigD = 1 Then DLigD = 0

A+

 

[ti_mouton]

Re : Copier/Coller des données de plusieurs feuille vers une autre feuille.

Ah oui c'était si simple que ça ! Décidement je manque cruellement de connaissances sur VBA ...

Un très grand merci pour ton aide et ta patience

 

[pouns94]

Re : Copier/Coller des données de plusieurs feuille vers une autre feuille.

Bonjour, j'ai un peu prés la meme demande, sauf que je suis moins expérimenté.

Ma demande est :

Je possède 2 feuilles sur le même classeur qui s'appelle exactement Devis et facture.xlsm

les deux feuilles sont: FACTURE et SITUATION FACTURATION

Lorsque j'ai saisie une facture et que j'enregistre
J'aimerais qu'à chaque enregistrement, certaines cellule soit automatiquement copié sur SITUATION FACTURATION.

J'aimerais que :

Je doit faire ma facture F0098 en la sélectionnant dans mon menu déroulant, je veux que les cellules concernées soit recopier dans SITUATION FACTURATION à la suite de mon tableau (pour la F0098 la ligne correspondant est la 99)
DANS SITUATION FACTURATION la colonne A comporte les numéros de facture ex : A2 correspond à la facture F0001
A55 correspond à la F0054, donc prochaine facture à faire A99 pour la facture F0098

Voici ci dessous les cellules qui doivent être recopier a chaque enregistrement.

Nom du client en F11 sur FACTURE (liste déroulante qui s'appelle nomclient2) partent sur SITUATION FACTURATION en B99

adresse du client en F12 sur FACTURE partent sur SITUATION FACTURATION en C99

H32 sur FACTURE partent sur SITUATION FACTURATION en D99

H34 sur FACTURE partent sur SITUATION CLIENT en E99

D37 sur FACTURE partent sur SITUATION CLIENT en F99

MERCI mille fois et d'avance pour votre futur aide.