copy range to Text (Tab delimited) (*.txt) file

[Dan]

Hello,
I need to copy a range (A4:N20) to a text file in a folder.
The format of the file should be Text (Tab delimited) (*.txt) .
Can I do that via code.
Many thanks.
Dan

 

[Dave Peterson]

Option Explicit
Sub testme()
Dim RngToCopy As Range
Dim NewWks As Worksheet

Set RngToCopy = ActiveSheet.Range("A4:N20")
Set NewWks = Workbooks.Add(1).Worksheets(1)

RngToCopy.Copy
NewWks.Range("a1").PasteSpecial Paste:=xlPasteValues

With NewWks.Parent
.SaveAs Filename:="C:\someexistingfolder\somename.txt", FileFormat:=xlText
.Close savechanges:=False
End With

End Sub

It creates a new workbook (single sheet) and copies the range to that sheet.
Then saves the new workbook as a text file.

 

[RB Smissaert]

Another way to do this:

Option Explicit

Sub Test()

Dim arr
Dim strFile As String

'replace this with suitable code
strFile = "C:\test.txt"

'replace this with suitable code
arr = ActiveWindow.RangeSelection

SaveArrayToText strFile, arr

End Sub


Sub SaveArrayToText(ByRef strFile As String, _
ByRef arr As Variant, _
Optional ByVal LBRow As Long = -1, _
Optional ByVal UBRow As Long = -1, _
Optional ByVal LBCol As Long = -1, _
Optional ByVal UBCol As Long = -1, _
Optional ByRef arrFields As Variant)

Dim r As Long
Dim c As Long
Dim hFile As Long

If LBRow = -1 Then
LBRow = LBound(arr, 1)
End If

If UBRow = -1 Then
UBRow = UBound(arr, 1)
End If

If LBCol = -1 Then
LBCol = LBound(arr, 2)
End If

If UBCol = -1 Then
UBCol = UBound(arr, 2)
End If

hFile = FreeFile

'Close before reopening in another mode.
'---------------------------------------
On Error Resume Next
Open strFile For Input As #hFile
Close #hFile

Open strFile For Output As #hFile

If IsMissing(arrFields) Then
For r = LBRow To UBRow
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, arr(r, c)
Else
Write #hFile, arr(r, c);
End If
Next c
Next r
Else
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, arrFields(c)
Else
Write #hFile, arrFields(c);
End If
Next c
For r = LBRow To UBRow
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, arr(r, c)
Else
Write #hFile, arr(r, c);
End If
Next c
Next r
End If

Close #hFile

End Sub


RBS