ich hätte nochmal eine kurze Frage. Das Makro funktioniert wunderbar außer eine Kleinigkeit. Wenn bei dem folgenden Code die Datei gespeichert wird und man diese dann nochmals öffnet fragt der nach den Hyperlink und entfernt in der Überschrift der Datei "wo eine Jahrezahl eingefügt wird" die Jahreszahl. Gibt es eine Möglichkeit den Code zu verändern, dass nur der Text in die neue Datei gespeichert wird, ohne den Hyperlink?
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