Macro to Copy Range and Paste Based on Cell Value

问题

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")

The below code constantly gives and error "Object Required"

Google Doc Version of the Worksheet

---

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

回答1:

Try the following code (in the sample sheet and in the description the target is in H column, not I as in sample 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.

回答2:

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

来源：https://stackoverflow.com/questions/28316086/macro-to-copy-range-and-paste-based-on-cell-value