VBA script gevraagd voor overzetten gegevens naar ander werkblad

[jan excel]

Hoi Expert,

In een excel file wil ik data overzetten naar een ander werkblad waarbij de tussen liggende kop titels niet wordt mee genomen.
Er is een bijlage toegevoegd dat duidelijk maakt wat precies de bedoeling is, althans dat hoop ik.

Aantal regels in het voorbeeld is niet de werkelijkheid, dit kan oplopen tot wel 150.000 regels.

Bij voorbaat dank.
Jan M


Bekijk bijlage voorbeeldhlpmij 1.0.xlsx

 

[edmoor]

Zoiets:

Sub Overzetten()
    Dim r As Long
    r = 3
    
    For i = 2 To Sheets("data").UsedRange.Rows.Count Step 2
        Sheets("overzetten").Range("A" & r & ":G" & r).Value = _
        Sheets("data").Range("A" & i & ":G" & i).Value
        r = r + 1
    Next i
End Sub

Waarbij ik zelf de ScreenUpdates uit zou zetten en een voortgangsbalkje zou laten meelopen als het om zoveel regels kan gaan.

 

[jan excel]

Edmoor,

bedankt, hier kom ik wel weer verder mee.


groet Jan.

 

[VenA]

Ik denk dat deze een ietsje sneller gaat.

Sub VenA()
With Sheets("data").Cells(1).CurrentRegion
    .AutoFilter 1, "<>machine nummer"
    .Copy Sheets("Overzetten").[A1]
    .AutoFilter
End With
End Sub

 

[edmoor]

Netjes :thumb:
Geeft wel een andere uitvoer op het blad Overzetten.

 

[snb]

Voor de liefhebbers:

Sub M_snb()
    sn = Sheet1.Cells(1).CurrentRegion
    Sheet2.Cells(20, 1).Resize(UBound(sn) \ 2, UBound(sn, 2)) = Application.Index(sn, Evaluate("2*row(1:" & UBound(sn) \ 2 & ")"), Evaluate("transpose(row(1:" & UBound(sn, 2) & "))"))
End Sub