UTF8 Optimierung export

Sub export3()
Dim r        As Long
Dim arr      As Variant
Dim file     As Variant
Dim makeFile As String
makeFile = ActiveWorkbook.Path & "\export.txt"  ' Pfad
Set file = CreateObject("Scripting.FileSystemObject").createtextfile(makeFile, True, True) ' _
_
_
_
_
_
export.txt wird erstellt
With ActiveSheet
arr = .Range(.[A1], .UsedRange.Cells(.UsedRange.Cells.Count)) ' der Bereich der _
Kopiert werden soll wird festgelegt
If Not IsArray(arr) Then ' wenn der Bereich kein Array (nur eine Zeile also die erste)
file.WriteLine arr ' wird die erste Zeile in die TXT geschrieben
Else
For r = 1 To UBound(arr) ' Hier wird das array auseinander gepflückt für jede Zeile  _
_
_
_
_
_
( bei dir 95)
file.WriteLine Join(WorksheetFunction.Index(arr, r, 0), Chr(9)) ' hier wird die _
Zeile r in die Txt eingetragen und die einzelnen Spalten mit einem  Tab(Chr(9)) getrennt
Next
End If
End Sub
die Zweite von SFB
Sub export2()
Tabelle1.UsedRange.Copy
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.GetFromClipboard
CreateObject("scripting.filesystemobject").createtextfile("c:\OF\UTf8.txt").write .GetText
End With
End Sub

exportiert
80	Ś
81	ś
82	Ş
83	Š
84	š
85	Ţ
86	ţ
87	Ű
88	ű
89	Ÿ
90	Ź