Kopieren van gegevens naar andere sheet

[roastfreak]

Beste Forum leden,

Ik zit al enkele dagen te worstelen, ben niet zo schitterend in deze dingen
In bijlage het excell bestandje zodat jullie hopelijk kunnen volgen
In tabblad "Lijst" zien jullie een hoop gegevens
(De werkelijke lijst is 60000 rijen lang, heb er een fragment uit geknipt)
In kolom I zien jullie telkens een code terugkomen beginnend met cz*
Deze zouden allemaal op het blad "Tabel" moeten worden geplakt, onder elkaar, kolom A1 beginnend.
Onder deze cz nummer staan steeds gegevens, die verband houden met deze cz nummer
Ik heb enkel de lijn average nodig van deze gegevens, en deze zouden achter de cz nr moeten worden geplakt in B1, C1,...,tem J1
Kunnen jullie dit voor elkaar krijgen ?

Alvast bedankt

Tim

 

[snb]

Hiermee gaat het lukken:

Sub tst()
  sq = Sheets(1).UsedRange
  st = Sheets(2).Cells(1, 1).Resize(UBound(sq) \ 23, 11)
        
  For j = 1 To UBound(sq) - 22 Step 23
    For jj = 1 To 10
      st(j \ 23 + 1, jj) = IIf(jj = 1, sq(j + 2, 9), sq(j + 20, jj + 1))
    Next
  Next
  Sheets("Tabel").Cells(1, 1).Resize(UBound(st), UBound(st, 2)) = st
End Sub

 

[roastfreak]

Lukt inderdaad, en alvast bedankt voor de snelle reply
Maar ik zie dat er een onregelmatigheid is in de gegevens
Rijen zijn niet altijd even hoog per cz nr
Kan er iets worden geprogrammeerd in de aard als je het woord "average" tegen komt, neem dan de gegevens over die in de kolommen staan achter dit woord ?
Deze gegevens moet dan vervolgens worden geplakt in sheet "Tabel" beginnend in kolom B1.

 

[snb]

Deze had je aan de hand van mijn vorige suggestie zelf kunnen bedenken:

Sub tst()
  sq = Sheets(1).UsedRange
  With Sheets(1).UsedRange.Columns(9)
    .AutoFilter 1, "cz*"
    sn = split(Replace(.SpecialCells(xlCellTypeVisible).Address, "$I$", ""),",")
    .AutoFilter
  End With
  With Sheets(1).UsedRange.Columns(2)
    .AutoFilter 1, "Average"
    sp = split(Replace(.SpecialCells(xlCellTypeVisible).Address, "$B$", ""),",")
    .AutoFilter
  End With
  st = Sheets(2).Cells(1, 1).Resize(UBound(sn), 10)
  For j = 1 To UBound(sn)
    st(j, 1) = sq(sn(j), 9)
    For jj = 2 To 10
      st(j, jj) = sq(sp(j), jj + 1)
    Next
  Next
  Sheets("Tabel").Cells(1, 1).Resize(UBound(st), UBound(st, 2)) = st
End Sub

 

[roastfreak]

Beste snb,

Mijn excuses, maar je bent me helemaal verloren
Zulke programmaties kan ik niet volgen, gaat mij petje te boven
Het spijt me zeer, maar er schort nog iets in de programmatie vermoed ik (zie resultaat)
Ik weet echt niet wat ik moet aanvangen, kan je hiernaar nogmaals 1x kijken aub
Alvast bedankt voor de geweldige hulp, apprecieer ik ten zeerste

Tim

 

[snb]

Om je terug te vinden; het kan veel eenvoudiger:

Sub tst()
  With Sheets(1).UsedRange.Columns(9)
    .AutoFilter 1, "cz*"
    .SpecialCells(xlCellTypeVisible).Copy Sheets("Tabel").Range("A1")
    .AutoFilter
  End With
  With Sheets(1).UsedRange
    .AutoFilter 2, "Average"
    .Offset(, 3).SpecialCells(xlCellTypeVisible).Copy Sheets("Tabel").Range("B1")
    .AutoFilter
  End With
End Sub

PS. Maar deze had je helemaal zelf kunnen bedenken.

 

[roastfreak]

niet helemaal...
Schitterend beste vriend, de macro werkt schitterend
Enorm bedankt voor jouw hulp

Mvg,
Tim