Макрос для копирования ячеек на четыре строки без использования select

Question

Этот код копирует записи из Sheet1! A2, Sheet1! B2 и т. Д. И вставляет их в Sheet2 с 3 строками между каждой записью.Я хочу продублировать этот код без использования .select.

Option Explicit

Sub Copy_Paste()

Dim i As Integer
For i = 1 To 100
    Sheets("Sheet1").Select 
    Range("A2,B2,C2,D2,E2").Select 
    ActiveCell.Range(Cells(i, 1), Cells(i, 2)).Select
    Selection.Copy 
    Sheets("Sheet2").Select 
    Cells(((i - 1) * 4) + 1, 1).Select 
    ActiveSheet.Paste 
Next i

End Sub

Это то, что у меня есть, но оно не работает.

Option Explicit

Sub Copy_Paste()

Dim i As Integer
For i = 1 To 100
    Dim ws1 As Worksheet, rng As Range, act As Range
        Set ws1 = Worksheets("Data")
        Set rng = ActiveSheet.Range("A2,B2,C2,D2,E2")
        Set act = ActiveCell.Range(Cells(i, 1), Cells(i, 2))
    Selection.Copy
    Dim ws2 As Worksheet, rng2 As Range
        Set ws2 = Worksheets("Calculate")
        Set rng2 = Cells(((i - 1) * 4) + 1, 1)
    ActiveSheet.Paste
Next i

End Sub

Answer 1

вы можете использовать Offset() свойство Range объекта

Sub Copy_Paste()
    Dim i As Long
    For i = 1 To 100
        Sheets("Sheet1").Range("A2,B2").Offset(i - 1).Copy Destination:=Sheets("Sheet2").Range("A1:B1").Offset((i - 1) * 4)
    Next
End Sub

, в то время как если вам нужны только значения для вставки, то это быстрее:

Sub Copy_Paste_Values()
    Dim i As Long
    For i = 1 To 100
        Sheets("Sheet2").Range("A1:B1").Offset((i - 1) * 4).Value = Sheets("Sheet1").Range("A2,B2").Offset(i - 1).Value
    Next
End Sub

Answer 2

Вы знаете, что можете просто сказать что-то вроде "Диапазон значений х = Диапазон значений y":

ws2.Range("A1:B4").Value = ws1.Range("A1:B4").Value

Если вы можете определить свои диапазоны с помощью Range(Cells(1,1), Cells(4,2)), тогда я уверен, что вы можете сделать всеВы хотите в одну строку

Answer 3

Я использовал этот тип операции в одном из моих кодов VBA:

      'do copy from reference "Answers_Source" worksheet
    wb.Sheets("Answers_Source").Range("h1:z160").Copy

   'now paste the formulas into the student exam workbook
   wb2.Sheets("Answers").Range("h1:z160").Paste     

Так что вы можете отредактировать это в своей ситуации.