Print after using macro to fill worksheet

Hello, bit of a strange one. Hopfully easy for someone.
I am using some code that automatically retrieves a list of data using a cell value as a search criteria and then it populates my worksheet with all the relevant data I require. The problem I have is when it comes to printing. Because the data has been added via code/macro the print are does not automatically expand to include all the data (eg if you look in page break view, it has not moved to include the data added as it would do if the data was added maually)?
The data inserted could be upto 100 pages long, but when I try to print it the page break is only part down page 1 and I then need to manually drag it down????
Is there a way around this in the code? Has it got something to do with EnableEvents?
The code in question is:

#If VBA7 Then
    Declare PtrSafe Function SetCurrentDirectoryA Lib _
    "kernel32" (ByVal lpPathName As String) As Long
#Else
    Declare Function SetCurrentDirectoryA Lib _
    "kernel32" (ByVal lpPathName As String) As Long
#End If


Sub ChDirNet(szPath As String)
    SetCurrentDirectoryA szPath
End Sub

Sub Extract_RD_1()
    Dim MyPath As String
    Dim SourceRcount As Long, Fnum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long
    Dim SaveDriveDir As String
    Dim FName As Variant
    Dim W As Worksheet
    Dim r As Long
    Dim I As Long
    
    'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
I = 7

    SaveDriveDir = CurDir
    ChDirNet "S:\File Name\File Name\"
    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
                                        MultiSelect:=True)
    If IsArray(FName) Then
        For Fnum = LBound(FName) To UBound(FName)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(FName(Fnum))
            On Error GoTo 0
            For Each W In mybook.Worksheets
            For r = 1 To WorksheetFunction.Max(W.Cells(Rows.Count, "A").End(xlUp).Row)
            If W.Cells(r, "A") = Range("A2") Then
            With ThisWorkbook.Worksheets(1)
            .Cells(3, 2).Value = W.Cells(r, "A").Value
            .Cells(I, 1).Value = W.Cells(r, "A").Offset(0, 3).Value
            .Cells(I, 5).Value = W.Cells(r, "A").Offset(0, 5).Value
            .Cells(I, 6).Value = W.Cells(r, "A").Offset(0, 6).Value
            End With
            I = I + 1
            End If
            Next r
            Next W
                
   mybook.Close SaveChanges:=False
   Next Fnum
'   Workbook.Worksheets.Columns.AutoFit
    End If
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
    ChDirNet SaveDriveDir
End Sub