USD $10.00 Output results into multiple CSV

Option Explicit
Option Base 1
Option Compare Text


Type Patterns
    Theme As String
    Keyword As String
End Type


Sub CreateOutput()
    Dim PatternCount As Long
    Dim CityCount As Long
    Dim PatternList() As Patterns
    Dim Prefix As String
    Dim Keyword As String
    Dim Airport As String
    Dim Group As String
    Dim OutKeyword As String
    Dim I As Long, J As Long
    Dim sss As Variant
    Dim lNrOfLines As Long
    Dim fn As Integer
    Dim m As Long
    
    sss = Timer
    
    'Initialise.
    PatternCount = Sheet2.[A1].CurrentRegion.Rows.Count - 1
    CityCount = Sheet1.[A1].CurrentRegion.Rows.Count - 1
    
    For m = 1 To Int(PatternCount * CityCount / 1000000) + 1
        Open ThisWorkbook.Path & "\AirOutputSample_" & m & ".csv" For Output Lock Read Write As #m
        Write #m, "Ad Group Prefix", "Ad Group", "Keyword", "Airport Code"
    Next
    
    'Load data from City - Top Patterns.
    ReDim PatternList(PatternCount)
    For I = 1 To PatternCount
        With Sheet2
            PatternList(I).Theme = .Cells(I + 1, 2)
            PatternList(I).Keyword = Application.WorksheetFunction.Proper(.Cells(I + 1, 3))
        End With
    Next I
    
    'Load data from next row in Input - City List.
    m = 1
    For I = 1 To CityCount
    '    Application.StatusBar = "City " & I
        With Sheet1
            Prefix = .Cells(I + 1, 4)
            Keyword = .Cells(I + 1, 5)
            Airport = .Cells(I + 1, 6)
        End With
        
        'Create output.
        For J = 1 To PatternCount
            Group = Prefix & " - " & PatternList(J).Theme
            OutKeyword = Replace(PatternList(J).Keyword, "{city}", Keyword)
            lNrOfLines = lNrOfLines + 1
            Write #m, Prefix, Group, OutKeyword, Airport
            If lNrOfLines Mod 1000000 = 0 Then m = m + 1
        Next J
    Next I
    
  '  Application.StatusBar = False
    For m = 1 To Int(PatternCount * CityCount / 1000000) + 1
        Close #m
    Next
    
    MsgBox Round(Timer - sss, 2)  '~70 sec. to run on my 64 bits 4 GB RAM laptop
End Sub