Copy row data to multiple columns in another sheet

Question

In column-A on sheet-1 there is a header row: "numbers" followed by the numbers 1-12. This populates A1:A13.

I need a copy paste skip VBA code to loop through column-A on sheet-1 and paste the first four cells (numbers: 1, 2, 3, 4) in sheet-2 column-B starting at sheet-2 B6 then copy the next four cells from sheet-1 (numbers: 5, 6, 7, 8) and copy it to sheet-2 column-B five rows down to the end of the last populated row from sheet-1 column-A (as there may be some in the dataset).

Sub CopySkipRws()
    Dim i As Long, r As Long
    Dim Rng As Range
    
    With Sheets("Sheet1")
        Set Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With
    
    For i = 6 To Rng.Count * 9 Step 9
        r = r + 1
        Sheets("Sheet2").Range("B" & i).Value = Rng(r).Value
    Next i
End Sub

Answer 1

You may take the basic idea from the below code:

Sub test()

    Dim w1 As Worksheet, w2 As Worksheet
    Dim i As Long, Lastrow1 As Long, Lastrow2 As Long
    
    With ThisWorkbook
    
        Set w1 = .Worksheets("Sheet1")
        Set w2 = .Worksheets("Sheet2")
        
    End With
    
    With w1
    
        Lastrow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        For i = 1 To Lastrow1 Step 4
        
            .Range("A" & i & ":A" & i + 3).Copy
            
            If i = 1 Then
                w2.Range("B6").PasteSpecial xlPasteValues
            Else
                Lastrow2 = w2.Cells(w2.Rows.Count, "B").End(xlUp).Row
                w2.Range("B" & Lastrow2 + 5).PasteSpecial xlPasteValues
            End If
        
        Next i
        
        Application.CutCopyMode = False
        
    End With       
    
End Sub