Meerdere tabbladen samenvoegen

[Puntdroad123]

Hallo,

Voor mijn werk ben ik bezig met de registratie van verschillende gegevens.
Van elke klant worden gegevens bijgehouden op een apart tabblad (zie voorbeeld), maar nu wil ik ze samenvoegen om de gegevens te kunnen analyseren.
De klant is niet de beperking in het aantal regels, dat is het perceel. Het kan zijn dat klant 1 maar 1 perceel heeft en klant 5 wel 8. Bij alle percelen van de klant moeten dan ook de NAW bijgevoegd worden.
Ze moeten onder elkaar komen in het 1e tabblad en de andere tabbladen moeten wel gevuld blijven nadat de gegevens gekopieerd zijn.
Dit lukt alleen allemaal nog niet echt, kan iemand mij daar bij helpen?

mvg Rick

 

[HSV]

Als jij die lege regel 29 verwijderd loopt het soepeltjes.

Sub hsv()
Dim sh As Worksheet, j As Long
For Each sh In Sheets
 If sh.Name <> "Totaal" Then
  For j = 1 To sh.[c8].CurrentRegion.Columns.Count
   With Sheets("totaal").Cells(Rows.Count, 1).End(xlUp)
     .Offset(1).Resize(, 6) = Application.Transpose(sh.[b1:b6].Value)
     .Offset(1, 6).Resize(, sh.[c9].CurrentRegion.Offset(1).Columns(j).Rows.Count) = Application.Transpose(sh.[c9].CurrentRegion.Offset(1).Columns(j))
   End With
   Next j
End If
Next sh
End Sub

 

[Puntdroad123]

Bedankt voor je hulp, het werk super!!

 

[HSV]

Graag gedaan,

Het kan overigens met een lusje minder.

Sub hsv()
Dim sh As Worksheet, sn
For Each sh In Sheets
 If sh.Name <> "Totaal" Then
  sn = sh.[c9].CurrentRegion.Offset(1)
   With Sheets("totaal").Cells(Rows.Count, 1).End(xlUp)
     .Offset(1).Resize(UBound(sn, 2), 6) = Application.Transpose(sh.[b1:b6].Value)
     .Offset(1, 6).Resize(UBound(sn, 2), UBound(sn)) = Application.Transpose(sn)
   End With
End If
Next sh
End Sub