Excel Line Limit

I am using the following code to pull in several work books and copy a page out of them. I am using the new version of excel so we can go beyond the 65536 limit, however when we started we were limited by the old excel.

Is it possible to modify this code to go to the bottom no matter what line? I have tried to change the code to a larger number but it debugs each time.

Option Explicit
 
Dim ToBook As String
Dim ToSheet As Worksheet
Dim NumColumns As Integer
Dim ToRow As Long
Dim FromBook As String
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim Lastrow As Long
Dim Firstrow1 As Long
Dim LastRow1 As Long
Dim Lrow1 As Long
Dim myRange As Range

Sub CompileAllChecksInFolder()
    Application.ScreenUpdating = False
    ChDrive ActiveWorkbook.Path
    ChDir ActiveWorkbook.Path
    ToBook = ActiveWorkbook.Name
    '---------------------------
    '- MASTER SHEET
    '---------------------------
    Set ToSheet = ActiveSheet
    NumColumns = ToSheet.Range("A1").End(xlToRight).Column
    ToRow = ToSheet.Range("A65536").End(xlUp).Row
    If ToRow <> 1 Then
        ToSheet.Range(ToSheet.Cells(2, 1), _
            ToSheet.Cells(ToRow, NumColumns)).ClearContents
    End If
    ToRow = 3
    '------------------------------------------
    '- main loop to open each file in folder
    '------------------------------------------
    FromBook = Dir("*.xls")
    While FromBook <> ""
        If FromBook <> ToBook Then
            Application.StatusBar = FromBook
            Transfer_data   ' subroutine below
        End If
        FromBook = Dir
    Wend

Set myRange = Range("B2", Range("B65536").End(xlUp))
myRange.Select
Application.ScreenUpdating = True
MsgBox ("I am going to clean up the data now, this may take several minutes.......")
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "PO Number"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "Invoice Number"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "DC number"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "Store Number"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "Division"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "Microfilm Number"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "Invoice Date"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "Invoice Amount"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "Date Paid"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "Discount"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "Amount Paid"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "Deduction Code"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "Combined Deduction"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "Payment"
    Range("A2:N2").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Underline = False
    End With
    Selection.Font.Bold = True
    Range("A2").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    With Selection.Font
        .Underline = False
        .Name = "Arial"
        .Size = 8
    End With
    Range("A2").Select
    Application.CutCopyMode = False
Application.ScreenUpdating = True

MsgBox ("Step One Is complete, validate information and go on to step 2")



End Sub

Private Sub Transfer_data()
    Workbooks.Open FileName:=FromBook
       'For Each FromSheet In Workbooks(FromBook).Worksheets
           'Sheets("Sheet1").Select
       Set FromSheet = Workbooks(FromBook).Worksheets("Sheet1")
          Lastrow = FromSheet.Range("A65536").End(xlUp).Row
             
        '-----------------------------------------------------
        '- copy/paste to master sheet
        FromSheet.Range(FromSheet.Cells(3, 1), _
        FromSheet.Cells(Lastrow, NumColumns)).Copy _
        Destination:=ToSheet.Range("A" & ToRow)
        '-----------------------------------------------------
        '- set next ToRow
        ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
    'Next
    Workbooks(FromBook).Close SaveChanges:=False
End Sub

Select allOpen in new window