从sheet1逐行复制/粘贴，并将其粘贴在sheet2上，中间有五个空行

Question

我正在尝试将表格从sheet1（行数最多可以变化到700）复制到sheet2，但是在sheet2上，每行必须粘贴5行，并且粘贴应该从第17行（下一个22）开始）。在Sheet1上，cloumn A只是文本，B，C和D具有公式。

我是位超级新手，已检查过Google，但没有找到合适的帮助。我想Loop应该可以做到，但是我的VBA技能几乎不存在，而且我不知道如何修改找到的代码。

Answer 1

在这里，您不确定这是否是您想要的。 A列仅是字符串，B到D列包含公式。您提到了在它们之间留出五个空行，但是我也看到您的描述也提到了从第17行开始，然后下一个应该从第22行开始，也就是四个空行。您可以通过将偏移量从4更改为5来更改空行的数量。

Sub copy_to_sheet2()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long
Dim count_1 As Integer
Dim count_2 As Integer
Dim offset As Integer
Dim last_row As Long

'your workbook / sheets name
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")

'get total rows of sheet 1
last_row = ws1.Range("A" & ws1.Rows.count).End(xlUp).Row
count_1 = 1 'sheet 1 counter
count_2 = 17 'sheet 2 counter
offset = 0 'offset / empty rows default value

    'loop sheet 1 from 1st row to last row
    For i = 1 To last_row

        If i = 2 Then
            offset = 4 '2nd loop change offset to 4
        ElseIf i > 2 Then
            offset = offset + 4 'subsequent loop offset + 4
        End If

        'copy sheet 1 column A to D row by row & paste values to sheet 2 with offset row by row
        ws1.Range("A" & count_1 & ":" & "D" & count_1).SpecialCells(xlCellTypeVisible).Copy
        ws2.Range("A" & count_2 + offset).PasteSpecial xlPasteValues

        'add counter
        count_1 = count_1 + 1
        count_2 = count_2 + 1

    Next i

End Sub