Empty rows in file generated from macros in 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