OK. I came up with something for you here. I saved this VBA code to its own Excel file, and I am using cells for you to place your "inputs" which may change, i.e.
Cell B1: Full path and name of data file from Access
Cell B2: Number of rows you want per file
Cell B3: Value you want in row 2 under "Reference" field
Cell B4: Value you want in row 2 under "Description" field
Cell B5: Path you want exported tab-delimited files to go to
As a default, the exported files are named with the following naming convention: yyyymmdd_s.tab (where s is a counter)
So if it works out that three files are exported today, they would be named:
20170531_1.tab
20170531_2.tab
20170531_3.tab
You can obviously make changes to the VBA code to suit your needs. I documented it a lot, so you can follow along to see what is happening where.
Code:
Sub MyConversionMacro()
Dim wbMacro As Workbook
Dim wbData As Workbook
Dim wbOutput As Workbook
Dim dataFName As String
Dim numRows As Long
Dim myRef As String
Dim myDescript As String
Dim expPath As String
Dim expFName As String
Dim lastRow As Long
Dim numSheets As Long
Dim newSheets As Long
Dim s As Long
Dim sht As Long
Dim sRow As Long
Dim eRow As Long
Dim lRow As Long
Application.ScreenUpdating = False
' Capture settings from macro workbook
Set wbMacro = ActiveWorkbook
dataFName = Range("B1") 'pull full file path and name of data file
numRows = Range("B2") 'pull number of rows from cell B2
myRef = Range("B3") 'pull Reference from cell B3
myDescript = Range("B4") 'pull Description from cell B4
expPath = Range("B5") 'pull export file path from cell B5
If Right(expPath, 1) <> "\" Then expPath = expPath & "\"
' Open and capture data file
Workbooks.Open (dataFName)
Set wbData = ActiveWorkbook
' Find last row with data on data file (using column A)
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
' Calculate how many tabs/files are needed
numSheets = Application.WorksheetFunction.RoundUp((lastRow - 1) / numRows, 0)
' Open a new blank workbook
Workbooks.Add
Set wbOutput = ActiveWorkbook
' Insert/delete new sheets as needed to new workbook
newSheets = numSheets - wbOutput.Sheets.Count
Select Case newSheets
Case Is > 0
For s = 1 To newSheets
Sheets.Add After:=Sheets(Sheets.Count)
Next s
Case Is < 0
For s = -1 To newSheets Step -1
Sheets(Sheets.Count).Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Next s
End Select
' Loop through and build each sheet
For sht = 1 To numSheets
wbData.Activate
' Copy header
wbData.Sheets(1).Range("A1:K1").Copy wbOutput.Sheets(sht).Range("A1")
' Copy rows
sRow = numRows * (sht - 1) + 2
eRow = numRows * sht + 1
wbData.Sheets(1).Range(Cells(sRow, "A"), Cells(eRow, "K")).Copy wbOutput.Sheets(sht).Range("A3")
' Populate output sheets
wbOutput.Activate
Sheets(sht).Activate
' Find last row with data
lRow = Cells(Rows.Count, "A").End(xlUp).Row
' Populate row 2
Range("A3:B3").Copy Range("A2")
Range("E2").FormulaR1C1 = "=SUM(R[1]C:R[" & lRow - 2 & "]C)"
Range("C2").FormulaR1C1 = "=IF(RC[2]>0,RC[2],"""")"
Range("D2").FormulaR1C1 = "=IF(RC[1]<0,RC[1],"""")"
Range("F2") = myRef
Range("G2") = myDescript
' Populate sequence number
Range("K2:K" & lRow).Formula = "=Row()-1"
Next sht
' Close data file
wbData.Close
' Loop through and export sheets
wbOutput.Activate
For sht = 1 To numSheets
Sheets(sht).Activate
' Build file name
expFName = Format(Date, "yyyymmdd_") & sht & ".tab"
' Export sheet
ActiveWorkbook.SaveAs Filename:=expPath & expFName, _
FileFormat:=xlText, CreateBackup:=False
Next sht
' Close workbook
wbOutput.Close True
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
Exporting data and summing per 5k lines
Windows 7 64bit 
Access 2013 64bit
Reply With Quote
