Hjælp til makro til samling af data

Hej
Har følgende makro til brug for samling af data fra x antal ark til et Samlet ark. Der er i alt ca 26.000 linier der skal samles men koden stopper efter ca 19.000 pga ressourcemæssige problemer i excel ????
Kan ikke lige gennemskue hvor i koden jeg kan rette/opimere så den kam samle alle data - det er jo ikke så mange linier....

Sub Makro1()
Dim ws As Worksheet
Dim i As Integer
Dim j As Integer
Dim myWksCount As Integer
Dim LastRow As Long

On Error GoTo Error_Handler

If WorksheetExists("Samlet") = True Then
    Application.DisplayAlerts = False
    Set ws = ActiveWorkbook.Sheets("Samlet")
    ws.Delete
    Application.DisplayAlerts = True
End If

myWksCount = ActiveWorkbook.Worksheets.Count

ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = "Samlet"

For i = 1 To myWksCount
    Sheets(i).Activate
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1").EntireColumn.Insert
    For j = 2 To LastRow
    Cells(j, 1).Value = i
    Next j
    Cells(2, 2).Select
    Selection.CurrentRegion.Select
    Selection.Copy
 
    Sheets("Samlet").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Cells(LastRow + 1, 1).Select
Next

For i = 1 To myWksCount
    Sheets(i).Activate
    Columns("A:A").Delete
Next

Error_Handler_Exit:
On Error Resume Next
Exit Sub

Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Makro1" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Sub
Function WorksheetExists(wsName As String) As Boolean

Dim ws As Worksheet
Dim ret As Boolean

On Error GoTo Error_Handler

    ret = False
    wsName = UCase(wsName)
    For Each ws In ThisWorkbook.Sheets
        If UCase(ws.Name) = wsName Then
            ret = True
            Exit For
        End If
    Next
    WorksheetExists = ret
   
Error_Handler_Exit:
On Error Resume Next
Exit Function

Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: WorksheetExists" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function