Home > other >  Excel VBA End(xlToRight) not operating as expected
Excel VBA End(xlToRight) not operating as expected

Time:06-14

The code below searches column A of the new templates, finds the relevant value in column A of the old template, copies and pastes the relevant row from the old template into the new one.

The templates are proper excel Tables. When the row gets copied, I only want it to select up until there is data. But when I execute the ".End(xlToRight)" my debugger goes to column"-4161" and bricks the code. Not sure why that is.

I don't want to select copy the entire row because then my table expands too much.

Sub copyrows()
Dim i As Integer, searchedrow As Integer, searchheader As Object


For i = 1 To 13

    Set searchheader = Sheets("New Input Template").Cells(i, 1)

    searchedrow = 0
    On Error Resume Next
    searchedrow = Sheets("Old Input Template").Columns(1).Find(what:=searchheader.Value, lookat:=xlWhole).Row
    On Error GoTo 0

    If searchedrow <> 0 And Cells(searchedrow, 1).Value <> "" Then
    
    Sheets("Old Input Template").Range(Cells(searchedrow, 1), Cells(searchedrow, 1).End(xlToRight)).Copy Destination:=Sheets("New Input Template").Cells(i, 1)
    
    End If

Next i

End Sub

enter image description here

enter image description here

CodePudding user response:

You aren't specifying the proper range in the correct area. Try the following and try to use variable for sheets instead of hard coding...

Also be careful that no columns are hidden as it will skip them when using xlToRight.

Sub copyrows()
Dim i As Integer, searchedrow As Integer, searchheader As Object
Dim oldWs As Worksheet
Set oldWs = Sheets("Old Input Template")


For i = 1 To 13

    Set searchheader = Sheets("New Input Template").Cells(i, 1)

    searchedrow = 0
    On Error Resume Next
    searchedrow = oldWs.Columns(1).Find(what:=searchheader.Value, lookat:=xlWhole).Row
    On Error GoTo 0

    If searchedrow <> 0 And Cells(searchedrow, 1).Value <> "" Then

    Range(oldWs.Cells(searchedrow, 1), oldWs.Cells(searchedrow, 1).End(xlToRight)).Copy Destination:=Sheets("New Input Template").Cells(i, 1)
    
    End If

Next i

End Sub
  • Related