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

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中的similliar列表匹配，那么将其余的数据粘贴到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或index/match函数，我只是为了学习而不是为了工作。希望你们能指导我。

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

谢谢

2 个解决方案

#1

Hello and welcome to *.

大家好，欢迎来到*。

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

#2

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:= construction移动数据。

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

#1