Macro - Paste in Delmited Format

[s0nicstang]

I am opening a text file and converting to comma, and space delmited to get the information into 4 col which works fine. I then want to save a copy in xlsx format which works fine. I then want to open that file and paste that data into a different sheet. When I do this the macro is pasting the 3 cells with no delimter? It also carries this onto other macros even when i close the work book. I have to restart my computer to get rid of it... Any ideas?

It takes this info from my saved sheets (rows A,B,C,D)

<TABLE style="WIDTH: 192pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=256 border=0><COLGROUP><COL style="WIDTH: 48pt" span=4 width=64><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; WIDTH: 48pt; BORDER-BOTTOM: #e0dfe3; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" align=right width=64 height=17>406001 1</TD><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; WIDTH: 48pt; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent" width=64>mlus</TD><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; WIDTH: 48pt; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent" width=64>oakex</TD><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; WIDTH: 48pt; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent" align=right width=64>19000</TD></TR></TBODY></TABLE>

and pastes it like this in one col A with a box inbetween each value

4060011 mlus oakex 19000

Code:

Sub CopyTextFile()
'
' CopyTextFile Macro
'
Dim T1 As String
T1 = Range("K2")
'
' Turn off alerts
Application.DisplayAlerts = False

'Open Text File and save copy
ChDir "S:\Operations\Prospectus"
Workbooks.OpenText Filename:="S:\file.txt", Origin _
:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
Comma:=True, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
ActiveWorkbook.SaveAs "S:\" & Format(Date, "mm-dd-yyyy") & ".xlsx", FileFormat:=51
textfileother = False
ActiveWindow.Close
'Copy Data
Workbooks.Open Filename:="S:\" & T1 & ".xlsx"
Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.Close

'Paste Data
Range("A1040000").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End Sub

 

[AlphaFrog]

Try something like this...

Sub CopyTextFile()
    '
    ' CopyTextFile Macro
    '
    Dim T1 As String[COLOR="Red"], ws As Worksheet
    Set ws = ActiveSheet[/COLOR]
    T1 = Range("K2")
    '
    ' Turn off alerts
    Application.DisplayAlerts = False
    
    'Open Text File and save copy
    ChDir "S:\Operations\Prospectus"
    Workbooks.OpenText Filename:="S:\file.txt", Origin _
    :=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
    Comma:=True, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
    
    ActiveWorkbook.SaveAs "S:\" & Format(Date, "mm-dd-yyyy") & ".xlsx", FileFormat:=51
    textfileother = False
    'ActiveWindow.Close
    
    'Copy Data
    'Workbooks.Open Filename:="S:\" & T1 & ".xlsx"
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy[COLOR="Red"] Destination:=ws.Range("A" & Rows.Count).End(xlUp).Offset(1)[/COLOR]
    ActiveWindow.Close

End Sub

Paste before closing the source workbook.