AW: mit VBA eine neue Datei erzeugen und daten rein ko
29.04.2015 17:52:59
fcs
Hallo Henning,
hier 2 Makro-Varianten.
Gruß
Franz
Sub Berechnung_Copy_and_Save()
'einzelnes Berechnungs-Blatt in neue Datei kopieren
Dim varDatei
'Blatt mit Berechnung in neue Datei kopieren
ActiveWorkbook.Sheets("Tabelle1").Copy
'in Kopie in allen Blättern Formeln durch Werte ersetzen
With ActiveWorkbook.Worksheets(1).UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
Range("B1").Select
'Kopie speichern
With Application.FileDialog(msoFileDialogSaveAs)
.ButtonName = "Auswählen"
.Title = "Datei speichern - Bitte Dateiname eingeben/auswählen"
.FilterIndex = 1
' .InitialFileName = "Berechnung" & Format(Now, "_YYYYMMDD_hhmmss") & ".xlsx"
.InitialFileName = "Berechnung_neu" & ".xlsx"
If .Show = -1 Then
varDatei = .SelectedItems(1)
ActiveWorkbook.SaveAs Filename:=varDatei, FileFormat:=51, addtomru:=True
ActiveWorkbook.Close savechanges:=False
End If
End With
End Sub
Sub Berechnung_Copy_and_Save_2()
'Komplette Datei unter neuem Namen speichern und Formeln entfernen
Dim varDatei, wks As Worksheet
Dim varDatei_Temp, wkbCopy As Workbook
With Application.FileDialog(msoFileDialogSaveAs)
.ButtonName = "Auswählen"
.Title = "Berechnung speichern - Bitte Dateiname eingeben/auswählen"
.FilterIndex = 1
' .InitialFileName = "Berechnung" & Format(Now, "_YYYYMMDD_hhmmss") & ".xlsx"
.InitialFileName = "Berechnung_neu" & ".xlsx"
If .Show = -1 Then
varDatei = .SelectedItems(1)
Else
Exit Sub
End If
End With
'temporäre Kopie speichern
With ActiveWorkbook
varDatei_Temp = .Path & "\tmp" & .Name
.SaveCopyAs varDatei_Temp
End With
'temporäre Datei öffnen
Set wkbCopy = Application.Workbooks.Open(Filename:=varDatei_Temp)
'in Kopie in allen Blättern Formeln durch Werte ersetzen
For Each wks In wkbCopy.Worksheets
With wks.UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
wks.Activate
Range("B1").Select
Next
wkbCopy.Sheets(1).Activate
'Berechnungs-Datei unter neuem Namen speichern
Application.DisplayAlerts = False 'vermeidet Rückfrage wegen Makros
wkbCopy.SaveAs Filename:=varDatei, FileFormat:=51, addtomru:=True
wkbCopy.Close savechanges:=False
Application.DisplayAlerts = True
'temporäre Datei wieder löschen
VBA.Kill varDatei_Temp
End Sub