简体   繁体   中英

Excel VBA to copy adjacent column in different sheet based on matching criteria

I have a macro to check sheet1 if the value in column A matches the value in the same column in sheet2, and if so, it copies the adjacent cell for each matched value from sheet1 into sheet2. Below is what I have so far, but I keep getting 'run time error 9' on the lastrowadd line and am not sure why. Any help would be appreciated :)

Sub CopyAdjacent()
    Dim i As Long, j As Long, colStatus As Long, lastrowAdd As Long, lastrowRemove As Long

    colStatus = 2 'your status column number
    lastrowAdd = Sheets(“Sheet1”).Cells(Sheets(“Sheet1”).Rows.Count, 1).End(xlUp).Row
    lastrowRemove = Sheets(“Sheet2”).Cells(Sheets(“Sheet2”).Rows.Count, 1).End(xlUp).Row

    For i = 1 To lastrowAdd
        For j = 1 To lastrowRemove
            If Sheets(“Sheet1”).Cells(i, 1).Value = Sheets(“Sheet2”).Cells(j, 1).Value Then
                Sheets(“Sheet2”).Cells(j, colStatus).Value = Sheets(“Sheet1”).Cells(i, colStatus).Value
            End If
        Next j
    Next i
End Sub

A couple of small changes have been made including the way both lastrowAdd and lastrowRemove have been defined. I also removed i and j from the definition.

Sub CopyAdjacent()
Dim colStatus As Long, lastrowAdd As Integer, lastrowRemove As Integer

colStatus = 2
lastrowAdd = Sheets(“Sheet1”).Cells(Rows.Count, 1).End(xlUp).Row
lastrowRemove = Sheets(“Sheet2”).Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lastrowAdd
    For j = 1 To lastrowRemove
        If Sheets(“Sheet1”).Cells(i, 1).Value = Sheets(“Sheet2”).Cells(j, 1).Value Then
            Sheets(“Sheet2”).Cells(j, colStatus).Value = Sheets(“Sheet1”).Cells(i, colStatus).Value
        End If
    Next
Next
End Sub

Also this isn't checking if on the same column the two are matching. It checks every column of Sheet2 against each one from Sheet1 . I think the below code is what you are looking for.

Sub CopyAdjacent()
' The below line has been changed, you may still omit lastrowRemove
Dim colStatus, lastrowAdd, lastrowRemove As Integer

colStatus = 2
lastrowAdd = Sheets(“Sheet1”).Cells(Rows.Count, 1).End(xlUp).Row
' The below line is now redundant in the new code
'lastrowRemove = Sheets(“Sheet2”).Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lastrowAdd
        If Sheets(“Sheet1”).Cells(i, 1).Value = Sheets(“Sheet2”).Cells(i, 1).Value Then
            Sheets(“Sheet2”).Cells(i, colStatus).Value = Sheets(“Sheet1”).Cells(i, colStatus).Value
        End If    
Next
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM