Question

我创建了一个宏来复制数据并粘贴到另一张表中。

需要粘贴数据的单元格引用位于表的最后一列。

范围A2：E2需要复制并粘贴在＆＃34; A2＆＃34; （在＆＃34; H2＆＃34;中提到）

以下代码不断给出错误＆＃34; Object Required＆＃34;

Sub Reconcile()

Set i = Sheets("Data")
Set e = Sheets("Final")

Dim r1 As Range
Dim r2 As Variant
Dim j
j = 2
Set r1 = i.Range(Cells(j, 1), Cells(j, 5))
Set r2 = i.Cells("I" & j).Value

Do Until IsEmpty(i.Range("A" & j))
    r1.Select
    Selection.Copy
    e.Range(r2).Select
    Selection.Paste
    j = j + 1
Loop

End Sub

Answer 1

您没有对所有变量进行维度。如果它没有解决您的错误，请告诉我们：

Sub Reconcile()

Dim i as Worksheet
Dim e As Worksheet
Dim r1 As Range
Dim r2 As Variant
Dim j As Integer

Set i = Sheets("Data")
Set e = Sheets("Final")

j = 2
Set r1 = i.Range(Cells(j, 1), Cells(j, 5))
Set r2 = i.Cells("I" & j).Value

Do Until IsEmpty(i.Range("A" & j))
    r1.Select
    Selection.Copy
    e.Range(r2).Select
    Selection.Paste
    j = j + 1
Loop

End Sub

Answer 2

尝试以下代码（在示例表和说明中，目标位于H列，而不是I，如示例VBA中所示）

Sub Reconcile()

Set i = Sheets("Data")
Set e = Sheets("Final")

Dim r1 As Range
Dim r2 As Range
Dim j As Integer
j = 2

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Do Until IsEmpty(i.Range("A" & j))
    Set r1 = i.Range(Cells(j, 1), Cells(j, 5))
    Set r2 = e.Range(i.Range("H" & j).Value)
    r2.Resize(1, 5).Value = r1.Value
    j = j + 1
Loop

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

编辑：

我不认为没有循环就可以实现这一点，但我已将代码编辑为：

禁用屏幕更新
禁用活动
禁用公式计算
指定范围值而不是复制/粘贴

在我的计算机测试中，在不到3秒的时间内完成18000行。

宏根据单元格值复制范围和粘贴

2 个答案: