Empty rows in file generated from macros in excel - excel

Question

I am trying to split a file with 120 records into files of at-most 50 records each. So expectation is it should genarate 2 files with 50 records and 1 file wit 20 but what I am getting is 3 files of 51 records with 1 empty file in the end for first 2 and 31 empty lines in 3rd file.
Sub SplitAndSaveFile()
Dim myRow As Long, myBook As Workbook, splitCount As Integer, thisWBName As String, splitCountStr As String, spaceRange As Range
lastRow = ThisWorkbook.Sheets("Data").Cells(rows.Count, 1).End(xlUp).Row
splitCount = 1
splitCountStr = CStr(splitCount)
thisWBName = Replace(ThisWorkbook.Name, ".xlsm", "") + "_Part"
For myRow = 4 To lastRow Step 50
Set myBook = Workbooks.Add
ThisWorkbook.Sheets("Data").rows(myRow & ":" & myRow + 49).EntireRow.Copy myBook.Sheets("Sheet1").Range("A1")
myBook.SaveAs (ThisWorkbook.Path + "\" + thisWBName + splitCountStr + ".txt"), FileFormat:=xlText
myBook.Close
splitCount = splitCount + 1
splitCountStr = CStr(splitCount)
Next myRow
MsgBox ("File(s) generated.")
End Sub

Answer 1

Export Data by Number of Rows
A Partial Quick Fix
Your code seemed to work fine on my testing data, so the only thing I could think of, considering your description of the issue, was that in column A there are formulas evaluating to an empty string at the bottom, which you don't want to include. To fix this, you could use the Find method:
Dim LastRow As Long: LastRow = ThisWorkbook.Worksheets("Data") _
.Columns("A").Find("*", , xlValues, , , xlPrevious)
Unfortunately, you also didn't consider the case when there will be fewer than 50 records to be copied to the last workbook. See how it is handled in the 'In-Depth' solution.
In Depth
This will export the records in a worksheet to new workbooks, saved as text, containing maximally 50 rows.
Option Explicit
Sub SplitAndSaveFile()
Const ProcName As String = "SplitAndSaveFile"
Dim dwbCount As Long ' Generated Workbooks Count
On Error GoTo ClearError
' Source
Const swsName As String = "Data"
Const sCol As String = "A"
Const sfRow As Long = 4
' Destination
Const dfCellAddress As String = "A1" ' needs to be 'A' since entire rows.
Const dMaxRows As Long = 50
Const dNameSuffix As String = "_Part"
' In the loop, this will be replaced by a number ('dwbCount').
Const dIdPlaceHolder As String = "?" ' the '?' is illegal for file names
' The following two lines are dependent on each other.
Const dFileExtension As String = ".txt"
Dim dFileFormat As XlFileFormat: dFileFormat = xlText
' Create a reference to the source first cell ('sfCell').
Dim swb As Workbook: Set swb = ThisWorkbook
Dim sws As Worksheet: Set sws = swb.Worksheets(swsName)
Dim sfCell As Range: Set sfCell = sws.Cells(sfRow, sCol)
' Calculate the number of records (rows) ('drCount').
' This will find the last non-blank cell i.e. cells containing
' formulas evaluating to an empty string are ignored.
' Make sure that the worksheet is not filtered and there are no hidden
' cells.
Dim slCell As Range
Set slCell = sfCell.Resize(sws.Rows.Count - sfRow + 1) _
.Find("*", , xlValues, , , xlPrevious)
If slCell Is Nothing Then Exit Sub ' no data
Dim slRow As Long: slRow = slCell.Row
' This is the preferred way, but besides a few pros, it behaves like 'End'
' i.e. it will find the last non-empty cell. A cell is not empty
' if it contains a formula evaluating to an empty string ('""'):
' it is blank.
'Dim slCell As Range
'Set slCell = sfCell.Resize(sws.Rows.Count - sfRow + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
'If slCell Is Nothing Then Exit Sub ' no data
'Dim slRow As Long: slRow = slCell.Row
' The classic last row using 'End' will find the last non-empty cell.
'Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, sCol).End(xlUp).Row
Dim drCount As Long: drCount = slRow - sfRow + 1
If drCount < 1 Then Exit Sub ' no data (highly unlikely but...)
' Determine the generic file path (dwbGenericFilePath)
Dim swbBaseName As String: swbBaseName = swb.Name
Dim DotPosition As String: DotPosition = InStrRev(swb.Name, ".")
If DotPosition > 0 Then swbBaseName = Left(swbBaseName, DotPosition - 1)
Dim dwbExtension As String: dwbExtension = dFileExtension
If Left(dwbExtension, 1) <> "." Then dwbExtension = "." & dwbExtension
Dim dwbGenericFilePath As String
dwbGenericFilePath = swb.Path & Application.PathSeparator & swbBaseName _
& dNameSuffix & dIdPlaceHolder & dwbExtension
Application.ScreenUpdating = False
' Additional variables used in the loop.
Dim srg As Range
Dim dwb As Workbook
Dim dws As Worksheet
Dim dfCell As Range
Dim dFilePath As String
Do Until drCount = 0
' Create a reference to the current source range.
If drCount > dMaxRows Then ' all workbooks but the last
Set srg = sfCell.Resize(dMaxRows).EntireRow
Set sfCell = sfCell.Offset(dMaxRows)
drCount = drCount - dMaxRows
Else ' the last workbook
Set srg = sfCell.Resize(drCount).EntireRow
drCount = 0
End If
' Copy the current source range to the current destination range.
dwbCount = dwbCount + 1 ' count the number of generated workbooks
Set dwb = Workbooks.Add(xlWBATWorksheet) ' one worksheet only
Set dws = dwb.Worksheets(1)
Set dfCell = dws.Range(dfCellAddress)
srg.Copy dfCell
' Save and close the current destination workbook.
dFilePath = Replace(dwbGenericFilePath, dIdPlaceHolder, CStr(dwbCount))
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs dFilePath, dFileFormat
Application.DisplayAlerts = True
dwb.Close SaveChanges:=False
Loop
ProcExit:
Application.ScreenUpdating = True
Select Case dwbCount
Case 0
MsgBox "No files generated.", vbCritical, ProcName
Case 1
MsgBox "One file generated.", vbInformation, ProcName
Case Else
MsgBox dwbCount & " files generated.", vbInformation, ProcName
End Select
Exit Sub
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Sub