Macro works for several loops and then slows down

Hi all,

I am running the following macro in order to take rows from one sheet, and based on the contents of particular columns, pasted those rows into another sheet.

Sub Import_New_1st_Line_Calls_User2()

Sheets("1st Line Sample").Calculate


   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer

On Error GoTo Err_Execute
   'Start search in row
   LSearchRow = 11

   'Start copying data to next free row
   With Sheets("User 2")
   LCopyToRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
   End With

   While Len(Range("A" & CStr(LSearchRow)).Value) > 0

      'If value in column AB = "2nd Line", copy entire row
      If Range("AG" & CStr(LSearchRow)).Value = "User 2" Then

         'Select row to copy
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy

         'Paste into Tracker
         Sheets("User 2").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste

         'Move counter to next row
         LCopyToRow = LCopyToRow + 1

         Sheets("1st Line Sample").Select

      End If

      LSearchRow = LSearchRow + 1

   Wend
   
   Application.CutCopyMode = False
   Range("A3").Select
      
    Sheets("User 2").Select
    Columns("AF:AG").Select
    Selection.ClearContents
    Sheets("1st Line Sample").Select
   
   Exit Sub

Err_Execute:
   MsgBox "An error occurred."

End Sub

The above seems to run for around 25 rows and then it slow down (taking around 30+ seconds) to process each row.

Assuming that the sheets are formatted correctly and the relevant data is present, is there any reason why this may be occurring after a seemingly random amount of loops?

Thank you.

You can speed up the copy buy using ranges in vba instead of selecting. The selection takes time and is unnecessary.