Datei nur Text kopieren

Sub SpeichernAls()
Dim Pfad As String, NName As String, Ext As String, Jahr As String
Dim Dlg As FileDialog, WBM As Workbook, WBNeu As Workbook
On Error GoTo Fehler
'** Anpassungen
Set WBM = Workbooks("MVT Makro.xlsm") ' Diese Datei
Pfad = "C:\Temp\" 'Der Startpfad
NName = "MVT"
Ext = ".xlsx"
Application.ScreenUpdating = False
Jahr = WBM.Worksheets(1).Range("DasTextJahr").Value
MsgBox "Bitte wählen Sie den Ordner aus, in welchen die Datei gespeichert werden soll."
'Verzeichnis wählen
Set Dlg = Application.FileDialog(msoFileDialogFolderPicker)
With Dlg
.AllowMultiSelect = False
.InitialFileName = Pfad
.Title = "Speicherort auswählen"
End With
If Dlg.Show = True Then
Pfad = Dlg.SelectedItems(1) & "\"
'Neue Datei erstellen
Set WBNeu = Workbooks.Add
'Blätter kopieren
WBM.Sheets(Array("MVT 1 Seite 1", "MVT 1 Seite 2", "MVT 1 Seite 3", _
"MVT 1 Seite 4", "MVT 1 Regional")).Copy after:=WBNeu.Sheets(1)
Application.CutCopyMode = False
'Erstes Blatt der Neuen Datei löschen
Application.DisplayAlerts = False
WBNeu.Sheets(1).Delete
WBNeu.Sheets(6).Delete
WBNeu.Sheets(6).Delete
Application.DisplayAlerts = True
'Die neue Datei schpeichern
WBNeu.SaveAs Filename:=Pfad & NName & "_" & Jahr & Ext, _
FileFormat:=xlOpenXMLWorkbook
'Die ursprüngliche Datei achliessen
WBM.Close False 'False= ohne speichern schliessen
End If
Err.Clear
Fehler:
Application.DisplayAlerts = True
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub