非常紧急！！请高手帮忙..

pureshadow

仅F列的，其他类推：
Sub test()
Dim MyRow As Long
Dim i As Long, x As Long
    MyRow = Sheets("sheet1").Range("f65536").End(xlUp).Row + 1
For x = 1 To 6 Step 2
    For i = 4 To 20
        Sheets("sheet1").Cells(MyRow, 6) = Sheets("sheet4").Cells(i + (x - 1) * 10, 2)
    MyRow = MyRow + 1
    Next
Next
End Sub