Copier coller feuilles Excel dans nouvel onglet avec variabl

Bonjour,

Dans la suite de mon précédent post je cherche à créer une nouvelle macro.

Voici ce que je voudrai faire :

Pour chacun de mes onglets de "Janvier" à "Décembre" je cherche à copier mes données de A2:B2 jusqu’à la fin et coller les données dans l'onglet Global. Ensuite il faudrait que dans l'onglet Global je rajoute en colonne C de quel onglet provient les données --> Janvier / Fevrier/.....

Vous trouverez le fichier ci-joint avec l'exemple pour janvier fevrier.

Je vous remercie d’avance pour votre précieuse aide.

Bien cordialement,

Aurélie.

Bonjour,

à tester,

ps/ j'ai renommé l'onglet "Septembre"

ÉDIT: j'avais oublié d'ajouter le mois

Sub Macro1()
Sheets("Global").Range("A2:C60000").ClearContents
mois = Array("Janvier", "Fevrier", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Decembre")
For i = LBound(mois) To UBound(mois)
 lastrw1 = Sheets("Global").Cells(Rows.Count, 1).End(xlUp).Row + 1
 lastrw2 = Sheets(mois(i)).Cells(Rows.Count, 1).End(xlUp).Row
 addrA = Range(Cells(lastrw1, 1).Address, Cells(lastrw1 + lastrw2 - 2, 2).Address).Address
 addrB = Range(Cells(2, 1).Address, Cells(lastrw2, 2).Address).Address
 addrC = Range(Cells(lastrw1, 3).Address, Cells(lastrw1 + lastrw2 - 2, 3).Address).Address
 Sheets("Global").Range(addrA).Value = Sheets(mois(i)).Range(addrB).Value
 Sheets("Global").Range(addrC).Value = mois(i)
Next
End Sub

Bonjour,

Une autre proposition à étudier.

Cdlt.

Option Explicit

Public Sub Consolidate_Data()
Dim ws As Worksheet, wsCible As Worksheet
Dim n As Long, rw As Long
Dim rng As Range
    Application.ScreenUpdating = False
    Set wsCible = ActiveWorkbook.Worksheets("Global")
    wsCible.Cells(1).CurrentRegion.Offset(1).Clear
    rw = 2
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> wsCible.Name Then
            n = ws.Cells(Rows.Count, 1).End(xlUp).Row
            If n > 1 Then
                ws.Cells(1).CurrentRegion.Offset(1).Copy Destination:=wsCible.Cells(rw, 2)
                wsCible.Cells(rw, 1).Resize(n - 1).Value = ws.Name
                rw = wsCible.Cells(Rows.Count, 1).End(xlUp).Row + 1
            End If
        End If
    Next ws
    With wsCible
        .Activate
        .[A1].Select
    End With
End Sub