Error in defining the range of rows

Question

I ´have three Sheets, sheet1, sheet2 and sheet3. sheet3 is generally considered as Result sheet.

In the first step, I copy the sheet1 column N to sheet3 column E. similarly column F of sheet 1 to column H of sheet3.

After copying the column, I wanted to compare the Id of sheet3, in column E with the ID of column A in sheet2. If matching then it is printed in the sheet3, and the other relative column Details are printed with Offset function.

I update the sheet2, with the new sheet data and the code suddenly stopped executing. There are no Errors occuring.

The program,simply keeps executing,and does not stop. When i debug, i found that the below line is highlighted.

If Not rng Is Nothing Then

additional Information: I have 118 rows in sheet1 , with first three rows merged and having Buttons.the data starts from row5. I have 990 rows in sheet2, with the data starting from row5, similar to sheet1, with Buttons as well. Could someone help me to rectify this issue. I have posted the issue already and could not find any positive Response. I Need Forum members to help me sort this issue .

Sub lookup()
Dim lrow As Long
Dim Totalcolumns As Long
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim i As Long
'Copy lookup values from sheet1 to sheet3
ThisWorkbook.Sheets("S1").Select
totalrows = ActiveSheet.UsedRange.Rows.Count

Range("N5:N" & totalrows).Copy Destination:=Sheets("S3").Range("E5")
Range("F5:F" & totalrows).Copy Destination:=Sheets("s3").Range("H5")
'Go to the destination sheet
Sheets("s3").Select
For i = 5 To totalrows
'Search for the value on sheet2
Set rng = Sheets("s2").UsedRange.Find(Cells(i, 5).Value)
'If it is found put its value on the destination sheet
If Not rng Is Nothing Then
Cells(i, 6).Value = rng.Value
Cells(i, 1).Value = rng.Offset(0, 1).Value
Cells(i, 2).Value = rng.Offset(0, 2).Value
Cells(i, 3).Value = rng.Offset(0, 3).Value
Cells(i, 4).Value = rng.Offset(0, 9).Value
Cells(i, 9).Value = rng.Offset(0, 10).Value
Cells(i, 12).Value = rng.Offset(0, 6).Value
Cells(i, 13).Value = rng.Offset(0, 5).Value
Cells(i, 14).Value = rng.Offset(0, 8).Value
End If
Next i
End Sub

Answer 1

Something like this?

lLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row