Sub CreateTextFiles()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim fpath As String
Dim fname As String
Dim fr As Long, lr As Long
Dim endOfFile As Boolean
Application.ScreenUpdating = False
fpath = "C:\Temp\Joe"
If Right(fpath, 1) <> "\" Then fpath = fpath & "\"
Set ws1 = ActiveSheet
Sheets.Add.Name = "Temp"
Set ws2 = ActiveSheet
ws1.Activate
fr = 2
Do
If endOfFile = True Then Exit Do
ws1.Activate
lr = Cells.Find(What:="X", After:=Cells(fr, "B"), LookIn:=xlFormulas2, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Row - 1
If lr = 0 Then
lr = Cells(Rows.Count, "B").End(xlUp).Row
endOfFile = True
End If
fname = ws1.Cells(fr - 1, "A") & ".txt"
Range(Cells(fr, "B"), Cells(lr, "C")).Copy ws2.Range("A1")
ws2.Activate
ActiveWorkbook.SaveAs Filename:=fpath & fname, FileFormat:=xlText, CreateBackup:=False
ws2.Range("A1").CurrentRegion.EntireRow.Delete
fr = lr + 2
Loop
Application.DisplayAlerts = False
ws2.Delete
Application.ScreenUpdating = True
MsgBox "Macro complete!"
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub