Макрос Excel для копирования диапазона с одного листа на другой

Question

У меня проблема с копированием диапазона с одного листа на другой.Я пытаюсь сделать это с кодом ниже

Sub zaladuj()
    Dim PND, DR As Worksheet
    Set PND = ActiveWorkbook.Sheets("sheet2")
    Set DR = ActiveWorkbook.Sheets("sheet1")
    Dim row As Integer
    Dim copyRng As Range, pasteRng As Range

    row = 4
    Do Until IsEmpty(DR.Cells(row, 2))
        row = row + 1
    Loop
    With DR
         Set copyRng = Range(Cells(3, 1), Cells(row, 5))
    End With

    With PND
        Set pasteRng = Range(Cells(3, 1), Cells(row, 5))
    End With

    copyRnd.Copy pasteRng

End Sub

Однако после запуска макроса ничего не происходит.Насколько я заметил, целые функции выполняются только в sheet2.Весь макрос помещается в объекты sheet2.

Answer 1

With сам по себе ничего не делает.Точки должны находиться перед самыми дальними, чтобы связать их с объектом, следующим за оператором With.

Option Explicit

Sub zaladuj()
    Dim PND As Worksheet, DR As Worksheet
    Set PND = ActiveWorkbook.Sheets("sheet2")
    Set DR = ActiveWorkbook.Sheets("sheet1")
    Dim row As Long
    Dim copyRng As Range, pasteRng As Range

    row = 4
    Do Until IsEmpty(DR.Cells(row, 2))
        row = row + 1
    Loop
    With DR
         Set copyRng = .Range(.Cells(3, 1), .Cells(row, 5))
    End With

    With PND
        Set pasteRng = .Range(.Cells(3, 1), .Cells(row, 5))
    End With

    copyRng.Copy pasteRng

End Sub

---

Обратите также внимание, что

Dim PND, DR As Worksheet

объявляет PND как Variant - см. Поправку выше.

---

Используйте Long вместо Integer, поскольку в Excel гораздо больше строк, чем может обработать Integer.

---

Возможно, вы можетезамените на Do петлю

row=DR.Cells(rows.count, 2).end(xlup).row

Answer 2

Это то, что нужно ожидать?

РЕДАКТИРОВАННЫЙ КОД

Option Explicit

Sub zaladuj()

    Dim PND As Worksheet, DR As Worksheet
    Dim row As Long

    With ThisWorkbook
        Set DR = .Sheets("Sheet1")
        Set PND = .Sheets("Sheet2")
    End With

    row = 4

    Do Until IsEmpty(DR.Cells(row, 2))

        DR.Range(DR.Cells(3, 1), DR.Cells(row, 5)).Copy PND.Range(PND.Cells(3, 1), PND.Cells(row, 5))

        row = row + 1

    Loop

End Sub