vba 基于单元格值复制范围和粘贴的宏

Macro to Copy Range and Paste Based on Cell Value

提问by Hellboy

I had created a macro to copy the data and paste into another sheet.

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

The cell reference where the data needs to be pasted is in the last column of table.

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

Range A2:E2 needs to be copied and paste at "A2" (mentioned in "H2")

范围 A2:E2 需要复制粘贴到“A2”（在“H2”中提到）

The below code constantly gives and error "Object Required"

下面的代码不断给出和错误“需要对象”

Google Doc Version of the Worksheet

工作表的 Google Doc 版本

---

---

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

采纳答案by BrakNicku

Try the following code (in the sample sheet and in the description the target is in Hcolumn, not Ias in sample VBA)

尝试以下代码（在示例表和描述中，目标在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

EDIT:

编辑：

I don't think you can achieve that without a loop, but I have edited the code to:

我不认为你可以在没有循环的情况下实现这一点，但我已将代码编辑为：

• disable screen updates
• disable events
• disable formula calculation
• assign range values instead of copy/paste

• 禁用屏幕更新
• 禁用事件
• 禁用公式计算
• 分配范围值而不是复制/粘贴

On my computer test with 18000 rows finished in less than 3 seconds.

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

回答by Dane I

You didn't dimension all your variables. Let me know if it doesn't fix your error:

您没有对所有变量进行尺寸标注。如果它不能解决您的错误，请告诉我：

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