Macro: C/C colonnes de plusieurs onglets dans un seul onglet

Bonjour,

Je souhaite coder une macro dans un but bien précis : copier les données des colonnes A et C de chaque onglet et les coller à la suite dans un seul et même onglet.

Je vous joins un fichier test pour que vous compreniez mieux ce que je souhaite faire. Sachant que mon fichier original a une centaine d'onglets que je ne me vois pas recopier manuellement...

En remerciant par avance l'âme charitable qui pourra m'aider !

j'ai placer un bouton pour exécuter la macro en feuille objectif

ne pas changer le nom de la feuille "OBJECTIF"

par contre on peut avoir autant d'autres feuilles

Bonjour,

Une autre proposition à étudier.

ALT F8, exécuter la procédure Copy_Data.

Cdlt.

Option Explicit

Public Sub Copy_Data()
Dim ws As Worksheet, ws2 As Worksheet
Dim n As Long, rw As Long
    Set ws2 = ActiveWorkbook.Worksheets("OBJECTIF")
    ws2.Cells(1).CurrentRegion.ClearContents
    rw = 1
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> ws2.Name Then
            With ws
                n = .Cells(Rows.Count, 1).End(xlUp).Row
                .Cells(1).Resize(n).Copy Destination:=ws2.Cells(rw, 1)
                .Cells(1).Offset(, 2).Resize(n).Copy Destination:=ws2.Cells(rw, 2)
            End With
            rw = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
        End If
    Next ws
End Sub

Bonjour le fil, bonjour le forum,

Dans le même style :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim OO As Worksheet 'déclare la variable OO (Onglet Objectif)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)

Set OO = Worksheets("OBJECTIF") 'définit l'onglet OO
For Each O In Worksheets 'boucle sur tous les onglets du classeur
    If Not O.Name = OO.Name Then 'condition : si le nom de l'onglet n'est pas "OBJECTIF"
        Set DEST = OO.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
        TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
        DEST.Resize(UBound(TV, 1), 1).Value = Application.Index(TV, , 1) 'renvoie dans DEST redimensionnée la première colonne de TV
        TV = O.Range("A1").CurrentRegion.Offset(0, 2) 'redéfinit TV
        DEST.Offset(0, 1).Resize(UBound(TV, 1), 1).Value = Application.Index(TV, , 1) 'renvoie dans DEST décalé et redimensionnée la première colonne de TV
    End If 'fin de la condition
Next O 'prochain onglet de la boucle
End Sub

Bonjour à tous,

ThauThème, on peut réduire comme ceci :

For Each O In Worksheets    'boucle sur tous les onglets du classeur
    If Not O.Name = OO.Name Then     'condition : si le nom de l'onglet n'est pas "OBJECTIF"
        Set DEST = OO.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)         'définit la cellule de destination DEST
        TV = O.Range("A1").CurrentRegion.Resize(, 3)         'définit le tableau des valeurs TV
        DEST.Resize(UBound(TV, 1), 2).Value = Application.Index(TV, Evaluate("row(1:" & UBound(TV, 1) & ")"), Array(1, 3))         'renvoie dans DEST redimensionnée les colonnes 1 et 3 de TV
    End If     'fin de la condition
Next O

klin89