Копирование / вставка строки за строкой из sheet1 и вставка его на sheet2 с пятью пустыми строками между ними

Question

Я пытаюсь скопировать строки из листа1 (количество строк может варьироваться до 700) в лист2, но на листе 2 каждая строка должна быть вставлена ​​с 5 пустыми строками между ними, и вставка должна начинаться со строки 17 (следующие 22 и т. Д. .). На Листе 1 кулон A - это просто текст, B, C и D имеют формулы.

Я супер-новичок и проверил Google, но не нашел нужной помощи. Я думаю, что цикл должен сделать это, но мои навыки 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