Copy offset range in for loop

user_14851508 0
Viewed 44

I have a script that loops through a list of ID numbers to check if there is a matching ID in another list, if there is a matching ID, it copies the email in the adjacent column and pastes it in another range. I am having trouble copying an offset range since it doesn't appear to be pasting any values. This script is not throwing any errors:

Sub tryThis()

Dim lookHere As Range, pasteHere As Range, cell As Range, searchList As Range

Set List1 = Range(Range("A1"), Range("A1").End(xlDown))
Set List2 = Range(Range("C1"), Range("C1").End(xlDown))
    
For Each cell In List1
    
    Set found = List2.Find(what:=cell, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

    If Not found Is Nothing Then
        
        cell.Offset(, 1).Resize(, 1).Copy Destination:=Cells(Rows.Count, "G").End(xlUp)
    
    End If
Next cell

End Sub
vba excel
1 Answers

This:

cell.Offset(, 1).Resize(, 1).Copy _
      Destination:=Cells(Rows.Count, "G").End(xlUp)

will copy the value into the same cell each run, since End(xlUp) takes you to the last occupied cell in the column, not the first empty cell. You need to Offset() one down to the next empty position. Also can do this with a direct value assignment:

Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Value = cell.Offset(0, 1).Value

Edit: if the cell you want to copy is from List 2 then:

Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Value = found.Offset(0, 1).Value
user_4788840
Related