vba 如果值匹配，则将数据粘贴到另一列

Paste data to another column if the value matches

提问by user2722393

I have wrote macro for fun (I have just started learning VBA) to loop through a list of names in a column in sheet1, and if the name matches to a similliar list in sheet2, then paste the rest of the data in sheet2. But it keeps me giving an application error, although I have checked my code a countless of time I am pretty sure is some dumb mistake but I am unable to find it.

我写了宏是为了好玩（我刚刚开始学习 VBA）来循环遍历 sheet1 中列中的名称列表，如果名称与 sheet2 中的类似列表匹配，则将其余数据粘贴到 sheet2 中。但它让我给出应用程序错误，尽管我已经无数次检查我的代码，但我很确定这是一些愚蠢的错误，但我无法找到它。

Option Explicit


Sub RangePasteColumn()
Dim j As Long, i As Long, lastRow1 As Long, lastRow2 As Long
Dim MyName As String

Sheets("sheet1").Activate
lastRow1 = Sheets("sheet1").Range("E" & Rows.Count).End(xlUp).Row

For j = 4 To lastRow1
MyName = Sheets("sheet1").Cells(j, "E").Value

Sheets("sheet3").Activate
lastRow2 = Sheets("sheet3").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lastRow2
    If Sheets("sheet3").Cells(i, "A").Value = MyName Then
    Sheets("sheet1").Activate
    Sheets("sheet1").Range(Cells(j, "F"), Cells(j, "I")).Copy
    Sheets("sheet3").Activate
    Sheets("sheet3").Range(Cells(i, "B"), Cells(i, "E")).Select
    ActiveSheet.Paste
End If

Next i
Application.CutCopyMode = False

Next j
Sheets("sheet3").Activate
Sheets("sheet3").Range("A1").Select

End Sub

I know you can do a simple vlookup or index/match function for this task, I was just doing for a sake of learning not for work. Hope u guys can guide me here.

我知道你可以为这个任务做一个简单的 vlookup 或索引/匹配功能，我只是为了学习而不是为了工作。希望你们能在这里指导我。

yea, one more thing, I was wondering if i can use the offset in my vba code, rather then writing which range to copy. if you know please let me know.

是的，还有一件事，我想知道是否可以在我的 vba 代码中使用偏移量，而不是编写要复制的范围。如果你知道请告诉我。

thanks

谢谢

回答by Giusepe Moreno

Hello and welcome to StackOverflow.

您好，欢迎来到 StackOverflow。

This is a solution I came up with. Hopefully will give you some insight on how to keep working to streamline your code and avoid irrelevant coding. Let me know if it works for you. Please save a copy before running the macro (as you should always).

这是我想出的解决方案。希望能给您一些关于如何继续工作以简化代码并避免不相关的编码的见解。请让我知道这对你有没有用。请在运行宏之前保存副本（您应该始终如此）。

Regards,

问候，

  Option Explicit
Sub RangePasteColumn()
Dim j As Long, i As Long, lastRow1 As Long, lastRow2 As Long
Dim sh_1, sh_3 As Worksheet 'Dim for the worksheet objects we will create below
Dim MyName As String

Set sh_1 = Sheets("sheet1") 'These objects avoid you having to write Sheets("SheetX") multiple times
Set sh_3 = Sheets("sheet3")

'Sheets("sheet1").Activate - There is no need to use Activate/Select a range or sheet. You can work on them by accessing
'the values directly
lastRow1 = sh_1.UsedRange.Rows.Count 'This is a better function to get the last used row (though there are disagreements on this)

For j = 4 To lastRow1
MyName = sh_1.Cells(j, 5).Value 'Column E = 5

'Sheets("sheet3").Activate - Again no need to use Activate a sheet
lastRow2 = sh_3.UsedRange.Rows.Count

    For i = 2 To lastRow2
        If sh_3.Cells(i, 1).Value = MyName Then 'Column A =1
            'Sheets("sheet1").Activate - I think you understood already :P
            sh_3.Cells(i, 2).Value = sh_1.Cells(j, 6).Value 'This is much better, faster way to "copy and paste" values
            sh_3.Cells(i, 3).Value = sh_1.Cells(j, 7).Value
            sh_3.Cells(i, 4).Value = sh_1.Cells(j, 8).Value
            sh_3.Cells(i, 5).Value = sh_1.Cells(j, 9).Value
            'Sheets("sheet3").Activate - Hopefully you did!
            'Sheets("sheet3").Range(Cells(i, "B"), Cells(i, "E")).Select
            'ActiveSheet.Paste
        End If

    Next i

Next j
'Sheets("sheet3").Activate - You most definitely did
'Sheets("sheet3").Range("A1").Select - Yeah! no need to use select either
MsgBox "Process Finished!"
End Sub

回答by Alex P

I'd try something like this. Define your ranges upfront and then iterate over each and use .Copy Destination:=construction to move data across.

我会尝试这样的事情。预先定义您的范围，然后迭代每个范围并使用.Copy Destination:=构造来移动数据。

Sub RangePasteColumn()
    Dim names As Range, name As Range, values As Range, value As Range

    Set names = Worksheets("Sheet1").Range("E4:E" & Worksheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row)
    Set values = Worksheets("Sheet3").Range("A2:A" & Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row)

    For Each name In names
        For Each value In values
            If name.value = value.value Then
                Worksheets("Sheet1").Range("F" & name.Row & ":I" & name.Row).Copy Destination:=Worksheets("Sheet3").Range("B" & value.Row & ":E" & value.Row)
            End If
        Next value
    Next name
End Sub