Sub a()
Dim i As Long, nwbk As Workbook, chemin$
chemin = "C:\Temp\"
Application.ScreenUpdating = False
For i = 2 To Columns.Count
With ThisWorkbook.ActiveSheet
If .Cells(1, i) <> "" Then
Set nwbk = Workbooks.Add(-4167)
.Range("A2:A5").Copy nwbk.Sheets(1).[A1]
.Cells(1, i).Resize(.Cells(.Rows.Count, i).End(xlUp).Row).Copy nwbk.Sheets(1).[B1]
nwbk.SaveAs chemin & .Cells(1, i).Text & ".txt", xlText, False
nwbk.Close True
End If
End With
Set nwbk = Nothing
Next i
End Sub