Thread: Split Excel workbooks in flat source

its done

I just delete the else condition. and now it perfectly give me 40 files , with exact number I want

Try this slight modification:

Sub SplitIntoText()

Const sStartCell = "A1"
Const sHeaderText = "MOBILE"
Const sFilePath = "C:\" 'Change to whichever directory you want the files in, ending with a \
Const sFileName = "DATA"
Const sFileExt = ".txt"

Dim rngCurrentExport As Range
Dim rngCellLoop As Range
Dim avMobileNumbers As Variant
Dim sDateText As String
Dim lFileCounter As Long
Dim lExportRows As Long
Dim lLastRow As Long
Dim iFileHandle As Integer
Dim lMobLoop As Long

avMobileNumbers = Array("980000001", "9900000002", "9700000003")
lFileCounter = 0

With ActiveSheet

  lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
  While Trim(.Range("A" & lLastRow).Value) = ""
    lLastRow = lLastRow - 1
  Wend
  
  Set rngCurrentExport = Range(sStartCell)
  
  While rngCurrentExport.Row <= lLastRow
  
    lFileCounter = lFileCounter + 1
    Select Case lFileCounter
      Case Is < 10
        lExportRows = 2000
      Case 10 To 18
        lExportRows = 4000
      Case Else
        lExportRows = 7000
    End Select
    
    If rngCurrentExport.Offset(lExportRows - 1, 0).Row > lLastRow Then
      lExportRows = lLastRow - rngCurrentExport.Row
    End If
    
    iFileHandle = FreeFile
    
    Open sFilePath & Format(Now(), "ddmmm") & " " & sFileName & lFileCounter & sFileExt For Output As iFileHandle
      Print #iFileHandle, sHeaderText
      
      For lMobLoop = LBound(avMobileNumbers) To UBound(avMobileNumbers)
        Print #iFileHandle, avMobileNumbers(lMobLoop)
      Next lMobLoop
    
      For Each rngCellLoop In .Range(rngCurrentExport, rngCurrentExport.Offset(lExportRows - 1, 0)).Cells
        Print #iFileHandle, rngCellLoop.Value
      Next rngCellLoop
      
      For lMobLoop = LBound(avMobileNumbers) To UBound(avMobileNumbers)
        Print #iFileHandle, avMobileNumbers(lMobLoop)
      Next lMobLoop
      
    Close #iFileHandle
    
    Set rngCurrentExport = rngCurrentExport.Offset(lExportRows, 0)
    
  Wend
  
End With
      
End Sub

The while loop after lLastRow is first set will exclude blank cells from the export.

awesome work dude
(y)

thanks a ton

Happy to help - please mark this thread as "Solved" if everything is working now.