Export to multiple Excel sheets

Function AllTablesToSheets()

Dim i As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim tbldef As TableDef
Dim xl As New Excel.Application
Dim wkbk As Excel.Workbook
Dim wksht As String

xl.Visible = True
xl.DisplayAlerts = False

Set db = CurrentDb
Set wkbk = xl.Workbooks.Add

    With wkbk
        
        .SaveAs FileName:="[COLOR="Red"]NEW EXCEL FILE PATH[/COLOR]"
        .Sheets("sheet2").Delete
        .Sheets("sheet3").Delete
        
            [COLOR="DarkGreen"]'LOOP THROUGH ALL TABLES[/COLOR]
            For Each tbldef In db.TableDefs
            
                Set rs = db.OpenRecordset(tbldef.Name, dbOpenDynaset)
                
                    wksht = tbldef.Name
                    .Sheets.Add after:=Sheets(Sheets.Count)
                    .Sheets(Sheets.Count).Name = wksht
                        
                        [COLOR="DarkGreen"]'WRITE FIELD NAMES[/COLOR]
                        For i = 0 To rs.Fields.Count - 1
                            .Sheets(wksht).cells(1, i + 1).Value = rs.Fields(i).Name
                        Next

.Sheets(wksht).Range(.Sheets(wksht).cells(1, 1), _
    .Sheets(wksht).cells(1, rs.Fields.Count)).Font.Bold = True

[COLOR="DarkGreen"]'COPY THE TABLE[/COLOR]
.Sheets(wksht).Range("A2").CopyFromRecordset rs

            Next tbldef
            
                    .Sheets("sheet1").Delete
                    
    End With

xl.DisplayAlerts = True

rs.Close
xl.ActiveWorkbook.Save
wkbk.Close
xl.Quit

Set wkbk = Nothing
Set xl = Nothing
Set rs = Nothing
Set db = Nothing

End Function

Function TableToSheets(recLimit as double, dataset as string)

[COLOR="DarkGreen"]'recLimit = NUMBER OF RECORDS PER SHEET[/COLOR]
[COLOR="DarkGreen"]'dataset = STATEMENT/QUERY/TABLE TO COPY FROM[/COLOR]

On Error GoTo EndOfSet

Dim i As Integer
Dim rowNum As Double [COLOR="DarkGreen"]'RECORD COUNTER PER SHEET WHEN WRITING[/COLOR]
Dim iteration As Double [COLOR="DarkGreen"]'SHEET NUMBER CURRENTLY WRITING TO[/COLOR]
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim xl As New Excel.Application
Dim wkbk As Excel.Workbook
Dim wksht As String

rowNum = 1
iteration = 1

xl.Visible = True
xl.DisplayAlerts = False

Set db = CurrentDb
Set rs = db.OpenRecordset(dataset, dbOpenDynaset)
Set wkbk = xl.Workbooks.Add

rs.MoveFirst

    With wkbk
        
        .SaveAs FileName:="[COLOR="red"]NEW EXCEL FILE PATH[/COLOR]"
        .Sheets("sheet2").Delete
        .Sheets("sheet3").Delete
        .Sheets("sheet1").Name = CStr(iteration)
        wksht = CStr(iteration)
        
            [COLOR="DarkGreen"]'INFINITE LOOP UNTIL ERROR THROWN AT .EOF[/COLOR]
            While iteration > 0
                    For i = 0 To rs.Fields.Count - 1
                        .Sheets(wksht).cells(1, i + 1).Value = rs.Fields(i).Name
                    Next
                        .Sheets(wksht).Range(.Sheets(wksht).cells(1, 1), _
                        .Sheets(wksht).cells(1, rs.Fields.Count)).Font.Bold = True
                        
                [COLOR="DarkGreen"]'START WRITING THE RECORDS (WILL ERROR AT .EOF)[/COLOR]
                Do Until rowNum > recLimit
                    rowNum = rowNum + 1
                        For i = 0 To rs.Fields.Count - 1
                            .Sheets(wksht).cells(rowNum, i + 1).Value = rs.Fields(i)
                        Next
                    rs.MoveNext [COLOR="DarkGreen"]'ERROR OCCURS HERE[/color]
                Loop

                    [COLOR="DarkGreen"]'GO TO THE NEXT SHEET[/COLOR]
                    rowNum = 1
                    iteration = iteration + 1
                    .Sheets.Add after:=Sheets(Sheets.Count)
                    .Sheets(Sheets.Count).Name = CStr(iteration)
                    wksht = CStr(iteration)
            Wend
            
    End With

EndOfSet:

For i = 1 To wkbk.Sheets.Count

    wkbk.Sheets(i).Select
    xl.Columns("A:A").Select
    wkbk.Sheets(i).Range(Selection, Selection.End(xlToRight)).Select
    xl.Selection.Columns.AutoFit

Next i
    
xl.DisplayAlerts = True

rs.Close
xl.ActiveWorkbook.Save
wkbk.Close
xl.Quit

Set wkbk = Nothing
Set xl = Nothing
Set rs = Nothing
Set db = Nothing

End Function