writing excel file to separate tab separated text files with header in each

Hello,
I am relatively new to VBA, so apologies if this is naive but I have been struggling with this. I have tried to look through past posts on this subject but have had a hard time resolving having headers and tab file output in the same solution (individually yes, but the code in each answer seemed very different and didn't know how to combine them. I am using Office 2013.

I have an excel file with 12 columns and 123 rows. The first row is a header row that I would like repeated in every file, along with one row of data in each file (so 122 files total). I need the files to be named what is in column A for each row, but that column not be included in the file (so column 2-12 will be written to file). Finally, I need the output saved as a Tab separated txt file.

Thank you very much in advance for your help...having a hard time figuring this one out on my own.

EcoHIV_metadata.xlsm

Hi see if this helps. Run the code named CreateFiles. Note that if there is a file with the same under the same folder it will be deleted and replaced with a new one.

Option Explicit

Sub CreateFiles()
    
    ' Change this to the path in your computer
    Const strBASE_PATH As String = "C:\Users\Alfred\Desktop\MyData\"
    
    ' The total amount of columns to be copied
    Const lDATA_COLUMN_WIDTH As Long = 11
    Const strEXTENSION As String = ".txt"
    
    
    Dim wbData As Workbook
    Dim wbFile As Workbook
    
    Dim lRow As Long
    Dim strFullPath As String
    Dim i As Long
    
    Call TurnExtrasOff
    
    ' Asign the variables
    Set wbData = ActiveWorkbook
    lRow = wbData.Sheets(1).Cells(wbData.Sheets(1).Rows.Count, "A").End(xlUp).Row
    
    ' Check if the filder exits if not create one
    If IsValidPath(strBASE_PATH, True) Then
    
        With wbData.Sheets(1)
            ' Loop through the data.
            For i = 2 To lRow
                
                ' Prepare the file path.
                strFullPath = strBASE_PATH & Cells(i, 1).Value & strEXTENSION
                
                ' If there is a file with the same name delete it.
                On Error Resume Next
                Kill strFullPath
                On Error GoTo 0
                
                ' Add a new workbook and copy the data.
                Workbooks.Add
                Set wbFile = ActiveWorkbook
                
                ' Copy the headers.
                wbFile.Sheets(1).Cells(1, 1).Resize(, lDATA_COLUMN_WIDTH).Value = _
                .Cells(1, 2).Resize(, lDATA_COLUMN_WIDTH).Value
                
                ' Copy the data.
                wbFile.Sheets(1).Cells(2, 1).Resize(, lDATA_COLUMN_WIDTH).Value = _
                .Cells(i, 2).Resize(, lDATA_COLUMN_WIDTH).Value
                
                
                ' Save and close the file the file.
                wbFile.SaveAs Filename:=strFullPath, FileFormat:=xlText
                wbFile.Close saveChanges:=True
            Next i
        End With
    End If
    
    Call TurnExtrasOn
    
    ' Cleanup
    Set wbData = Nothing
    Set wbFile = Nothing
      
    
End Sub

Private Function IsValidPath(ByVal strPath As String, Optional ByVal bCreatePath As Boolean = False) As Boolean
    
    Dim fso As Object

    Set fso = CreateObject("Scripting.FileSystemObject")

    'Check if folder exists.
    IsValidPath = fso.folderExists(strPath)

    'Create the directory.
    If bCreatePath And Not IsValidPath Then
        fso.CreateFolder strPath
        IsValidPath = True
    End If

    ' Clean up.
    Set fso = Nothing

End Function

Private Sub TurnExtrasOff()
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
End Sub
Private Sub TurnExtrasOn()
    
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub

Hope it helps

Hi,

needs less than 20 code lines with standard VBA functions !

Code to paste directly in the worksheet module :

Sub Demo()
    With [A1].CurrentRegion
        VN = .Columns(1).Value
        VA = .Columns(2).Resize(, .Columns.Count - 1).Value
        H$ = Join(Application.Index(VA, 1), vbTab) & vbNewLine
        F% = FreeFile
        
        For R& = 2 To .Rows.Count
            Open ThisWorkbook.Path & "\" & VN(R, 1) & ".txt" For Output As #F
            Print #F, H & Join(Application.Index(VA, R), vbTab)
            Close #F
        Next
        
        Erase VA, VN
    End With
End Sub

Enjoy it and don't forget to clik on bottom left star "Add Reputation", thanks !

Thank you both so much. I ended up using Marc's reply and it worked perfectly!

I am glad I was able to help. My code is longer indeed but easier to understand and debug. Just saying yeah its more than 20 lines!

Thanks