Info van meerdere sheets naar één sheet

[RonnyV]

Beste Experts,

ik heb dit forum (en enkele andere) al doorzocht, maar vind niet direct de passende code voor mijn probleem.
Voor een onderzoek maakte ik voor iedere proefpersoon een eigen Excelblad aan. Dit excelblad is 130:20 en is iedere keer op dezelfde manier opgebouwd. (vb. A3 = "Voornaam", B3 = voornaam, ...)
Nu heb ik een zeventigtal tabbladen in totaal en had ik graag een finaal tabblad -een soort overzichtslijst- gemaakt, waarbij alle gegevens van iedere persoon (dus die 130x20 = 2600) onder elkaar opgelijst worden in één enkele rij (dus eerst A1, dan B1, C1, D1, ... T1, A2, B2, .. T130; eerst rijen, dan kolommen) en elke persoon een eigen kolom heeft. (dus A1 van werkblad 1 wordt in dit nieuwe werkblad A1, T1 van werkblad 4 wordt D20, ...). Ik weet dat ik dan bvb in mijn FinaalTabblad een rij ga hebben met allemaal "Voornaam" als gegevens, maar dat is niet erg, ik zou het sowieso handmatig nog wat moeten bijschaven.
Dit alles om later aan de slag te kunnen met draaitafels edm, dus het overhevelen van de opmaak is niet nodig.

Op zich leek het me niet enorm moeilijk, maar het lukt me nu al twee dagen langs geen kanten om iets te fabriceren. Zou iemand me uit de nood kunnen helpen?

Alvast enorm bedankt.

 

[Warme bakkertje]

Een klein voorbeeldbestandje is geen overbodige luxe.

 

[RonnyV]

Dat zou inderdaad geen slecht idee zijn, alvast dank voor je interesse!
In bijlage een voorbeeldfile met vier sheets (ipv 68). Het is wel zo dat er soms cellen zijn die altijd inhoudsloos zijn (vb. C1 of I107). Indien in het FinaalTabblad de lege rijen die dit veroorzaakt automatisch zouden verwijderd worden, zou dat handig zijn, maar indien dat voor een pak extra codeerwerk zorgt, is dit niet nodig. Als ik een overzichtstabel zou hebben, zou ik u al enorm dankbaar zijn.

Bekijk bijlage Voorbeeldbestand.xlsx

 

[HSV]

Ik heb een extra blad aangemaakt om het te vergelijken met 'FinaalTabblad'.
De code kan je later gemakkelijk aanpassen.

Sub hsv()
Dim ws As Worksheet, i As Long, j As Long, clmn As Long
 clmn = 1
  For Each ws In ThisWorkbook.Worksheets
    If Not ws.Name = "Blad1" And Not ws.Name = "FinaalTabblad" Then
  For i = 1 To 4
  For j = 1 To ws.Cells(i, Columns.Count).End(xlToLeft).Column
    Sheets("Blad1").Cells(Rows.Count, clmn).End(xlUp).Offset(1) = ws.Cells(i, j)
      Next j
     Next i
   End If
  clmn = clmn + 1
    Next ws
End Sub

 

[snb]

Dat doe je toch simpelweg met formules in het totaatblad waarin je per kolom verwijst naar de cellen in een bepaald gegevensblad ?

bijv =1!A2

 

[RonnyV]

Enorm bedankt HSV!
Dankzij jouw macro werkt het prima. Eerst had ik nog wat problemen omdat de lege cellen niet werden gekopieerd maar door deze automatisch te vervangen door "-"

Sub num()
Dim ws As Worksheet, i As Long, j As Long
  For Each ws In ThisWorkbook.Worksheets
     If Not ws.Name = "Blad 1" Then
  For i = 1 To 150
  For j = 1 To 20
     If ws.Cells(i, j) = "" Then
       ws.Cells(i, j) = "-"
     End If
     Next j
    Next i
    End If
 Next ws
End Sub

lukte het uitstekend. Nogmaals enorm bedankt HSV!