(gelijke) Excel Sheets consolideren met VBA macro

[muldertie]

Hallo,
Ik ben bezig met een VBA script, maar lijk er niet helemaal uit te komen. Wat ik wil is verschillende (gelijke) sheets consolideren naar 1 sheet in de worksheet.
Hij moet echter de sheet waarvan de info verkregen is in de rij bijvoegen.

In heb een excel als voorbeel meegestuurd voor de verduidelijking.

Tabbladen AU t/m FIN zijn allemaal gelijk qua opmaak.

De range A3 t/m V144 moet van elke aparte sheet kopieren naar sheet consolidatie (onder elkaar).
Sheet AU komt in consolidatie op B3: W144 en dan in kolom A referentie naar de sheet (AU)
Sheet BE komt in consolidatie op B145:W286 en dan in kolom A referentie naar de sheet (BE)
enz.

Gekopieerde selectie mag als waardes geplakt worden.

Het onder elkaar kopieren lukt me wel, waar ik vastloop is om de referentie van de sheet erbij te plakken (als waarde).

Wie o wie kan mij helpen?

 

[cow18]

Sub Consolideren()
   Set shc = Sheets("consolidate")                              'je werkblad
   For Each sh In ThisWorkbook.Worksheets                       'alle werkbladen aflopen
      If sh.Name <> shc.Name Then                               'behalve dat ene werkblad
         sn = sh.Range("A3:V144").Value                         'te kopieren gegevens in een array inlezen
         With shc.Range("A" & Rows.Count).End(xlUp).Offset(1)   'eerstvolgende A-cel
            .Resize(UBound(sn)).Value = sh.Name                 'A-kolom vullen met naam werkblad
            .Offset(, 1).Resize(UBound(sn), UBound(sn, 2)).Value = sn   'ernaast de gegevens
         End With
      End If
   Next
End Sub

 

[snb]

Begin met alle samengevoegde cellen te verwijderen.

 

[muldertie]

Hartlijk dank, werkt perfect!
Als ik meerder sheets wil uitsluiten (If sh.Name <> ...)

Nogmaals dank.

 

[snb]

Anders:

Sub M_snb()
  c00 = "consolidate"
    
  For Each it In Sheets
    it.Cells.UnMerge
    [B][COLOR="#FF0000"]If InStr(c00 & "AU", it.Name) = 0 Then[/COLOR][/B]
      With CreateObject("ADODB.recordset")
        .Open "SELECT * FROM `" & it.Name & "$`", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & it.Parent.FullName & ";Extended Properties=""Excel 12.0"""
        Sheets(c00).Cells(Rows.Count, 1).End(xlUp).Offset(1).CopyFromRecordset .DataSource
      End With
    End If
  Next
 End Sub

 

[cow18]

Sub Consolideren()
   Set shc = Sheets("consolidate")                              'je werkblad
   For Each sh In ThisWorkbook.Worksheets                       'alle werkbladen aflopen
      If Not IsNumeric(Application.Match(sh.Name, Array([COLOR="#FF0000"][B]"consolidate", "cz", "ba"[/B][/COLOR]), 0)) Then                         'behalve dat enkele werkbladen
         sn = sh.Range("A3:V144").Value                         'te kopieren gegevens in een array inlezen
         With shc.Range("A" & Rows.Count).End(xlUp).Offset(1)   'eerstvolgende A-cel
            .Resize(UBound(sn)).Value = sh.Name                 'A-kolom vullen met naam werkblad
            .Offset(, 1).Resize(UBound(sn), UBound(sn, 2)).Value = sn   'ernaast de gegevens
         End With
      End If
   Next
End Sub

binnen de haakjes van die array een opsomming van alle werkbladen, die je wenst te negeren