How can I export all the columns with data present (header) in the first row?

In this example image, I would like to export only the column with "FOO" present:

this is my code;

Sub Worksheets_to_txt() 

    Dim ws As Worksheet
    Dim relativePath As String
    Dim answer As VbMsgBoxResult

    relativePath = ActiveWorkbook.Path

    answer = MsgBox("Export in TXT?", vbYesNo, "Run Macro")    
    If answer = vbYes Then

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each ws In ActiveWorkbook.Worksheets

        ws.Select
        ws.Copy
        ActiveWorkbook.SaveAs Filename:= _
        relativePath & "\" & ws.Name & ".txt", _
        FileFormat:=xlText, CreateBackup:=False
        ActiveWorkbook.Close
        ActiveWorkbook.Activate
    Next
     End If

End Sub

Thank you

CodePudding user response：

Please, replace this part of your code:

    For Each ws In ActiveWorkbook.Worksheets

        ws.Select
        ws.Copy
        ActiveWorkbook.SaveAs Filename:= _
        relativePath & "\" & ws.Name & ".txt", _
        FileFormat:=xlText, CreateBackup:=False
        ActiveWorkbook.Close
        ActiveWorkbook.Activate
    Next

with this one:

   Dim rngDel As Range, lastCol As Long, wsNew As Worksheet, HDRow As Long, i As Long
   For Each ws In ActiveWorkbook.Worksheets
        ws.Copy
        Set wsNew = ActiveWorkbook.Sheets(1)
        'search for the header row:
        For i = 1 To 100
            If WorksheetFunction.CountA(wsNew.rows(i)) > 0 Then
                HDRow = i: Exit For
            End If
        Next i
        lastCol = wsNew.cells(HDRow, wsNew.Columns.count).End(xlToLeft).Column
        'place all cells from the first row, without headers, in a Union range
        For i = 1 To lastCol
            If wsNew.cells(HDRow, i).value = "" Then
                If rngDel Is Nothing Then
                    Set rngDel = wsNew.cells(HDRow, i)
                Else
                    Set rngDel = Union(rngDel, wsNew.cells(HDRow, i))
                End If
            End If
        Next i
        'delete the columns without header, if any:
        If Not rngDel Is Nothing Then rngDel.EntireColumn.Delete
        Set rngDel = Nothing 'preparing the range for the next sheet use
        ActiveWorkbook.saveas fileName:= _
                relativePath & "\" & ws.Name & ".txt", _
                FileFormat:=xlText, CreateBackup:=False
        ActiveWorkbook.Close
        ActiveWorkbook.Activate
    Next
End Sub

It places the first row cells without a header in a range and delete this range entire columns at once, before saving the workbook.