Copier Coller plage de différent onglets en une seule avec bouton

Bonjour Mesdames, Bonjour Messieurs,

J'ai le fichier ci joint qui contient plusieurs feuilles:

  • 6 extractions, chacune avec dans sa feuille : E1, E2,..., E6
  • 2 feuilles de données complémentaires : "Liste" et "Compléments"
  • 1 feuilles devant rassembler les 6 extractions croisé (par formules) avec les données complémentaires : "Extraction Globale"
  • 1 feuille avec une bouton: "Test"

Je sais que la question à déjà été posée, mais mon auto-formation ayant commencer depuis seulement 3 jours le temps me manque pour ce que je souhaite faire...

J'aimerais donc que les données de chaque extraction soit copier coller sur la feuille "Extraction Globale" à la suite les unes des autres (A2 pour la première), après qu'une suppression des lignes 2 à xxx à été faite sur cette même feuille

J'ai réussi à faire la suppression avec le code suivant:

Sub Robert()
Dim ws As Worksheet,
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "Extraction Globale" Then
ws.Rows("3:1048576").Delete Shift:=xlUp
End If
Next ws
End Sub

Mais je n'arrive pas à faire la copier coller des autres onglets... Ma dernière tentative ressemble à cela:

Sub robert()
Dim ws As Worksheet, derlig As Long
For Each ws In ActiveWorkbook.Worksheets

If ws.Name = "Extraction Globale" Then
ws.Rows("3:1048576").Delete Shift:=xlUp
End If

If ws.Name <> "Liste" And ws.Name <> "test" And ws.Name <> "Extraction Globale" And ws.Name <> "Compléments" Then
derlig = Range("A65536").End(xlUp).Row

'je colore et utilise .Select juste pour voir le cheminement de la macro à terme ils disparaitrons
Range(Cells(2, 1), Cells(derlig, 23)).Select
  With Selection.Interior
        .Color = 65535
End With
End If
Next ws
End Sub

Par conséquent, une âme charitable peut elle m'aider à corriger ce code immonde qui est le mien et m'expliquer d'où viens mon erreur ? En pièce jointe le fichier concerné

Un grand merci par avance pour vos retours

21fichier-test.xlsm (965.01 Ko)

Bonjour JKennedy !

Voici le code qui te permet de rassembler toute tes feuilles E1 // E2 etc... sur ta feuille Extraction Globale en ayant au préalable, remis le tableau à blanc :

Sub CopieColle()
Dim x As Long, y As Long
x = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row
If x > 2 Then
    Sheets(9).Rows("2:" & x).Delete
End If
For y = 3 To 8
    x = Sheets(y).Range("A" & Rows.Count).End(xlUp).Row
    Sheets(y).Range("A2:W" & x).Copy
    x = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row
    Sheets(9).Range("A" & x).PasteSpecial
Next
End Sub

Par contre je n'ai pas compris ce que tu voulais faire avec ta feuille "Compléments" :/

WAAAAAA ! C'est magnifique *.* Un immense merci

Aurais tu l'amabilité de m'expliquer comment ça fonctionne ? Parce que par exemple si je rajoute des feuilles qui ne doivent pas être concerné par le copier coller elle serons ignorées par ta macro?

Pour la feuille compléments, elle me sert juste à remplir les 4 dernières colonne du tableau. L'organisation de mon entreprise étant PA-RF-AI-TE, il me faut 2/3 extractions différentes pour avoir toutes les données souhaitées...

Aurais tu l'amabilité de m'expliquer comment ça fonctionne ?

C'est partie pour des explications, ligne par ligne ;D !

Dim x As Long, y As Long

Ici je déclare mes variables "x" et "y"

x = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row

Ici je compte le nombre de ligne de ma feuille numéro 9, qui correspond dans ton classeur à la feuille "Extraction Globale"

C'est à dire, que ta feuille numéro 1 est la feuille la plus à gauche de ton classeur, puis la numéro 2 est celle qui viens juste après. Tu continue jusqu’à arriver à la feuille qui t’intéresse !

If x > 2 Then
    Sheets(9).Rows("2:" & x).Delete
End If

Si mon nombre de ligne est supérieur à deux, alors je supprime les lignes 2 à x (qui est égal au nombre de ligne calculé dans la ligne au dessus)

For y = 3 To 8
    x = Sheets(y).Range("A" & Rows.Count).End(xlUp).Row
    Sheets(y).Range("A2:W" & x).Copy
    x = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row
    Sheets(9).Range("A" & x).PasteSpecial
Next

Le Forcréé une boucle dans ta macro. C'est à dire que tout ce qui va se trouver entre ton Foret ton Nextva se répéter tant que la condition n'est pas remplie.

Ici notre condition c'est que notre variable "y" commence avec la valeur 3, et doit atteindre 8 pour arrêter la boucle !

Et l'action à répéter est de compter le nombre de ligne dans la feuille numéro "y" et de copier celle-ci

Sheets(y).Range("A2:W" & x).Copy

puis d'aller en feuille 9 et de les coller

Sheets(9).Range("A" & x).PasteSpecial

à la première ligne vide trouver grâce à

x = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row !

A chaque fois qu'on arrive au Next, y prend automatiquement une valeur supplémentaire, et on boucle

Et voilà tu a ton copier // coller

Parce que par exemple si je rajoute des feuilles qui ne doivent pas être concerné par le copier coller elle serons ignorées par ta macro?

En effet, si tu rajoute des feuilles tu devra changer les numéros de feuilles indiquées dans ce code :p

Pour la feuille compléments, elle me sert juste à remplir les 4 dernières colonne du tableau

Et du coup j'ai un truc à faire avec sa ou c'est bon :0 ?

Alors déjà j'ai absolument tout compris du premier coup et ça c'est un exploit !

Un très grand merci pour tes explications ultra clair ! je me mets le lien en Favoris ça me resservira !

Pour les feuilles que je rajouterais je m'arrangerais pour les mettre après histoire de ne pas tout casser x)

Et pour les 4 dernières colonne tu n'a rien faire avec ! Tu en as déjà suffisamment fait

encore un immense merci à toi !!!

sujet résolu ^.^

Désolé pour le double poste mais

AAAAAAAH J'ai trouvé une erreur ! Je sais pas pourquoi mais le copier coller se fait toujours sur la dernière ligne du copier coller précédent ! Help Me !

Sauf que si je fait

Sub CopieColle()
Dim x As Long, y As Long
x = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row
If x > 2 Then
    Sheets(9).Rows("2:" & x).Delete
End If
For y = 3 To 8
    x = Sheets(y).Range("A" & Rows.Count).End(xlUp).Row
    Sheets(y).Range("A2:W" & x).Copy
    x = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row
    Sheets(9).Range("A" & x + 1).PasteSpecial
Next
End Sub 

Qui me paraissait être une bonne idée, cela m'efface totalement la ligne 2 et me colle tout en ligne 3... Par contre les copier coller ne se superposent plus

Mea Culpa

Sa marchera mieux comme sa :

Sub CopieColle()
Dim x As Long, y As Long, z As Long
x = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row
If x > 2 Then
    Sheets(9).Rows("2:" & x).Delete
End If
For y = 3 To 8
    x = Sheets(y).Range("A" & Rows.Count).End(xlUp).Row
    Sheets(y).Range("A2:W" & x).Copy
    z = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row
    If z < 2 Then
        x = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row + 1
    Else
        x = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row
    End If
    Sheets(9).Range("A" & x).PasteSpecial
Next
End Sub

Rebonjour Juice !

Encore merci pour tes réponses rapide et efficace. Malheureusement ta solution ne fonctionne pas J'ai toujours le copier coller qui se fait sur la dernière valeur de copier coller précédent.

Je cherche aussi de mon coté (Si je trouve une solution c'est que j'ai été touché par un miracle)

EDIT

Le miracle à eu lieu ! J'ai trouvé une solution pas très orthodoxe à mon avis mais elle fonctionne ! J'en suis tout ému

Sub CopieColle()
Dim x As Long, y As Long, z As Long
x = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row
If x > 2 Then
    Sheets(9).Rows("2:" & x).Delete
End If
For y = 3 To 8
    x = Sheets(y).Range("A" & Rows.Count).End(xlUp).Row
    Sheets(y).Range("A2:W" & x).Copy
    z = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row
    If z < 2 Then
        x = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row + 1
    Else
        x = Sheets(9).Range("A" & Rows.Count).End(xlUp).Row
    End If
    If y = 3 Then
    Sheets(9).Range("A" & x).PasteSpecial
    End If
    If y >= 4 Then
    Sheets(9).Range("A" & x + 1).PasteSpecial
    End If
Next
End Sub

En tout cas un grand merci Juice je serais encore en train de galérer sans ton aide et tes explications x)

Rechercher des sujets similaires à "copier coller plage different onglets seule bouton"