Exporting Excel Workbook to Multiple Text Files Based on Formula

[TMatch]

Hello!

I would like to design a macro that will split and Excel workbook with 3 columns (Name, Account Number, Occurrence) into multiple text files. The first column (named Occurrence) contains a formula which assigns a number (an occurrence) to each row of data depending on how many times the name appears in the file. I would like to create a Macro which will create a separate text file for each Occurrence number.

For example:

Occurrence Name AccountNumber
1 Bob 1234
2 Bob 1235
3 Bob 1236
1 Tom 1234
2 Tom 1235
1 Jim 1234

I should get three files:
File 1:
1 Bob 1234
1 Tom 1234
1 Jim 1234

File 2:
2 Bob 1235
2 Tom 1235

File 3:
3 Bob 1236

Thanks in advance for your help

 

[DanteAmor]

Try this

Sub Exporting_Workbook_Multiple_Text_Files()
  Dim sh As Worksheet, c As Range, ky As Variant, wb As Workbook, wPath As String, lr As Long
  Application.SheetsInNewWorkbook = 1
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Set sh = ActiveSheet
  'If you want a specific folder change to i.e: wPath = "C:\folder\files\"
  wPath = ThisWorkbook.Path & "\"
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  lr = sh.Range("A" & Rows.Count).End(xlUp).Row
  With CreateObject("scripting.dictionary")
    For Each c In sh.Range("A2:A" & lr)
      .Item(c.Value) = Empty
    Next
    For Each ky In .Keys
      sh.Range("A1").AutoFilter 1, ky
      Set wb = Workbooks.Add
      sh.AutoFilter.Range.Range("A2:C" & lr).Copy 'Change 2 to 1 if you also want to copy the header.
      Range("A1").PasteSpecial xlPasteValues
      wb.SaveAs wPath & ky & ".txt", FileFormat:=xlTextMSDOS
      wb.Close False
    Next
  End With
  sh.ShowAllData
End Sub