I sent the other answer before I was finished. Here are some sample
code that I use to do this type of thing. There are three functions
and then some basic code to help you sort and delete the un-needed data
prior to "Save As" function. This should get you going.

Let me know if this helps.


************************************************** *****************

Function OpenConfigFile()

Workbooks.OpenText Filename:=strPath & "\YOUR FILE NAME.txt",
Origin:=437, _
StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False,
Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True

End Function



Function FindText()

Selection.Find(What:=TextStr, After:=ActiveCell, LookIn:=xlFormulas
_
, LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

End Function


Function SaveConfigFile()

Application.DisplayAlerts = False
ChDir strPath
ActiveWorkbook.SaveAs Filename:=strPath & "\" & TextStr2,
FileFormat:= _
xlText, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True

End Function




Cells.Select
Range("A1").Activate
ActiveWorkbook.Worksheets("Config").Sort.SortField s.Clear
ActiveWorkbook.Worksheets("Config").Sort.SortField s.Add
Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Config").Sort
.SetRange Range("A1:X10000")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Columns("A:A").Select
TextStr = "Email"
Call FindText
ActRow = ActiveCell.Row €“ 1

Rows("1:" & ActRow).Select
Range("A" & ActRow).Activate
Selection.Delete Shift:=xlUp

Columns("A:A").Select
TextStr = "FAX"
Call FindText
ActRow = ActiveCell.Row

Rows(ActRow & €œ:10000€�).Select
Range("A" & ActRow).Activate
Selection.Delete Shift:=xlUp


TextStr2 = "Email Addresses.TXT"
Call SaveConfigFile

--