Option Explicit
Sub Kopieren()
Dim objDatei As Workbook
Dim SelBereich As Range
Dim i As Integer
Dim strDateiname As String, strPfad As String
'Dateiname
strDateiname = Range("C4") & Range("D16") & ".xls"
'Pfad
strPfad = _
IIf(Right$(Environ$("USERPROFILE"), 1) = "\", Environ$("USERPROFILE"), Environ$("USERPROFILE") & "\")
Set SelBereich = Selection
Set objDatei = Workbooks.Add
'nicht benötigte Tabellen löschen
Application.DisplayAlerts = False
For i = objDatei.Sheets.Count To 2 Step -1
objDatei.Sheets(i).Delete
Next i
Application.DisplayAlerts = True
'Bereich kopieren
SelBereich.Copy objDatei.Sheets(1).Range("A1")
'Datei speichern unter
objDatei.SaveAs strPfad & strDateiname
'Datei schließen
objDatei.Close False
End Sub
Gruß Tino
strPfad = Environ$("USERPROFILE")
If Right$(strPfad, 1) = "\" Then strPfad = Left$(strPfad, Len(strPfad) - 1)
strPfad = Left$(strPfad, InStrRev(strPfad, "\")) & "Administrator\Eigene Dateien\Raporte\"
diese
strPfad = _
IIf(Right$(Environ$("USERPROFILE"), 1) = "\", Environ$("USERPROFILE"), Environ$("USERPROFILE") & "\")
strPfad = strPfad & "Eigene Dateien\Raporte\"
Modul Modul1
Option Explicit
Sub Kopieren()
Dim objDatei As Workbook
Dim SelBereich As Range
Dim i As Integer
Dim strDateiname As String, strPfad As String
'Dateiname
strDateiname = Range("C4") & Range("D16") & ".xls"
'Pfad
strPfad = Environ$("USERPROFILE")
If Right$(strPfad, 1) = "\" Then strPfad = Left$(strPfad, Len(strPfad) - 1)
strPfad = Left$(strPfad, InStrRev(strPfad, "\")) & "Administrator\Eigene Dateien\Raporte\"
Set SelBereich = Range("A1:G27")
Set objDatei = Workbooks.Add
'nicht benötigte Tabellen löschen
Application.DisplayAlerts = False
For i = objDatei.Sheets.Count To 2 Step -1
objDatei.Sheets(i).Delete
Next i
Application.DisplayAlerts = True
'Bereich kopieren
SelBereich.Copy objDatei.Sheets(1).Range("A1")
'Datei speichern unter
objDatei.SaveAs strPfad & strDateiname
'Datei schließen
objDatei.Close False
End Sub
Gruß Tino
Um eine Auswahl in einer neuen Excel-Datei zu speichern, kannst du den folgenden VBA-Code verwenden:
ALT + F11, um den VBA-Editor zu öffnen.Einfügen > Modul, um ein neues Modul zu erstellen.Option Explicit
Sub Kopieren()
Dim objDatei As Workbook
Dim SelBereich As Range
Dim i As Integer
Dim strDateiname As String, strPfad As String
'Dateiname
strDateiname = Range("C4") & Range("D16") & ".xls"
'Pfad
strPfad = Environ$("USERPROFILE") & "\Eigene Dateien\Raporte\"
Set SelBereich = Range("A1:G27")
Set objDatei = Workbooks.Add
'nicht benötigte Tabellen löschen
Application.DisplayAlerts = False
For i = objDatei.Sheets.Count To 2 Step -1
objDatei.Sheets(i).Delete
Next i
Application.DisplayAlerts = True
'Bereich kopieren
SelBereich.Copy objDatei.Sheets(1).Range("A1")
'Datei speichern unter
objDatei.SaveAs strPfad & strDateiname
'Datei schließen
objDatei.Close False
End SubstrPfad-Variable an, wenn du einen anderen Speicherort verwenden möchtest.Fehler: Ungültiger Dateiname
Fehler: Pfad nicht gefunden
Eine alternative Methode, um eine Auswahl zu speichern, besteht darin, den Bereich manuell zu kopieren und in eine neue Datei einzufügen:
CTRL + C.CTRL + N).CTRL + V ein.Datei > Speichern unter.Beispiel 1: Auswahl speichern mit dynamischem Dateinamen Mit dem obigen VBA-Skript wird der Dateiname dynamisch aus den Zellen C4 und D16 generiert, was dir ermöglicht, verschiedene Dateien basierend auf deinem Inhalt zu erstellen.
Beispiel 2: Auswahl speichern in einem bestimmten Ordner
Du kannst den Pfad so anpassen, dass die Datei in einem bestimmten Ordner, wie z.B. "Dokumente", gespeichert wird, indem du den strPfad-Wert entsprechend änderst.
ActiveSheet anstelle von Sheets(1), um flexibler mit verschiedenen Arbeitsblättern arbeiten zu können.1. Wie kann ich die Auswahl speichern, ohne VBA zu verwenden? Du kannst die Auswahl manuell kopieren und in eine neue Excel-Datei einfügen, wie im Abschnitt "Alternative Methoden" beschrieben.
2. Ist der Code auch für Excel 365 geeignet? Ja, der bereitgestellte VBA-Code funktioniert in Excel 365 sowie in älteren Versionen von Excel. Achte darauf, dass Makros in deiner Excel-Umgebung aktiviert sind.