宏以基於單元格值復制范圍和粘貼

Question

我創建了一個宏來復制數據並粘貼到另一張紙上。

表的最后一列是需要粘貼數據的單元格引用。

范圍A2：E2需要復制並粘貼到“ A2”（在“ H2”中提到）

下面的代碼不斷給出錯誤“ Object Required”

工作表的Google文檔版本

---

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列中，而不是示例VBA中的I ）

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行的測試。