AW: Kopieren und speichern über VBA
16.08.2017 11:06:51
fcs
Hallo Tom,
die momentan aktive Arbeitsmappe kannst du im Code als ActiveWorkbook ansprechen.
Die Datei in der das Makro gespeichert ist als ThisWorkbook.
Wenn der Name "Mappe2" für die 2. Arbeitsmappe nicht konstant ist, dann muss man sich hier etwas einfallen lassen. Wenn es sich um eine neu angelegte Arbeitsmappe handelt, dann sollte man die vom Makro mit anlegen lassen. Siehe weitere Variante.
Es gibt verschieden Umgebungsvariablen, die VBA vom Betriebssystem abrufen kann.
Für das Desktop-Verzeichnis ist dies das Verzeichnis in der Umgebungsvariablen "Userprofile" verfügbar.
Gruß
Franz
Sub Kopieren_speichern()
' Kopieren_speichern Makro
Dim wkbAktiv As Workbook
Set wkbAktiv = ActiveWorkbook 'momentan aktive Arbeitsmappe
Range("A2:A4").Select
Selection.Copy
Windows("Mappe2").Activate
Range("A3").Select
ActiveSheet.Paste
wkbAktiv.Activate
Range("B2").Select
End Sub
Sub Kopieren_speichern_Variante()
' Kopieren_speichern Makro
' ThisWorkbook = Arbeitsmappe in der das Makro gespeichert ist
Range("A2:A4").Select
Selection.Copy
Windows("Mappe2").Activate
Range("A3").Select
ActiveSheet.Paste
ThisWorkbook.Activate
Range("B2").Select
End Sub
Sub Speichern_auf_Desktop()
' Makro1 Makro
Dim strPfad As String, strDatei As String
With Application
strPfad = VBA.Environ("Userprofile") & .PathSeparator & "Desktop" & .PathSeparator
End With
strDatei = "MeineDatei " & Format(Now, "YYYY-MM-DD") & ".xlsm"
'Datei mit Makros speichern
Application.DisplayAlerts = False 'schon vorhandene Datei wird ohne Rückfrage überschrieben
ActiveWorkbook.SaveAs Filename:=strPfad & strDatei, FileFormat:=52, CreateBackup:=False, _
addtomru:=True '52 = xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
End Sub
Sub Kopieren_und_Speichern()
' Kopieren_speichern Makro
' ThisWorkbook = Arbeitsmappe in der das Makro gespeichert ist
Dim wkbAktiv As Workbook, wkbNeu As Workbook
Dim wksAktiv As Worksheet
Dim strPfad As String, strDatei As String
Set wkbAktiv = ActiveWorkbook
Set wksAktiv = ActiveSheet
'neue Mappe mit 1 Tabellenblatt erstellen
Set wkbNeu = Application.Workbooks.Add(Template:=xlWBATWorksheet) 'Template ggf. anpassen
wksAktiv.Range("A2:A4").Copy Destination:=wkbNeu.Worksheets(1).Range("A3")
wkbAktiv.Activate
'Neue Datei mit Makros auf dem Desktop speichern
Application.DisplayAlerts = False 'schon vorhandene Datei wird ohne Rückfrage überschrieben
With Application
strPfad = VBA.Environ("Userprofile") & .PathSeparator & "Desktop" & .PathSeparator
End With
strDatei = "MeineKopie " & Format(Now, "YYYY-MM-DD") & ".xlsm"
wkbNeu.SaveAs Filename:=strPfad & strDatei, FileFormat:=52, CreateBackup:=False, _
addtomru:=True '51 = xlOpenXMLWorkbook, 52 = xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
wkbNeu.Close savechanges:=True
End Sub