AW: Workbook kopieren mit Userform
25.07.2018 11:18:23
fcs
Hallo Acaz,
mit SaveCopyAs wird eine komplette Kopie einer Datei erstellt.
Hier musst du die gespeicherte Kopie wieder öffnen und dann in den gewünschten Blättern die Formeln durch Werte erseten.
Nachfolgend hab ich das mal umgesetzt.
Gruß
Franz
Sub prcCopy_Nur_Werte_inkl_UF()
Dim wkbCopy As Workbook
Dim strNameCopy As String
Dim wkbAktiv As Workbook
Dim StatusCalc As Long
Set wkbAktiv = ActiveWorkbook
'Name Copy beliebig festlegen - darf nur nicht gleicher Pfad+gleicher Name sein
With wkbAktiv
strNameCopy = .Path & "\48Archiv\" & Left(.Name, InStrRev(.Name, ".") - 1) _
& Format(Now, "YYYY-MM-DD hhmm") & Mid(.Name, InStrRev(.Name, "."))
' strNameCopy = "D:\Test\" & Left(.Name, InStrRev(.Name, ".") - 1) _
& Format(Now, "YYYY-MM-DD hhmm") & Mid(.Name, InStrRev(.Name, "."))
End With
Application.Calculate
wkbAktiv.SaveCopyAs strNameCopy
'Makrobremsen lösen
With Application
.ScreenUpdating = False
.EnableEvents = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set wkbCopy = Application.Workbooks.Open(strNameCopy, UpdateLinks:=False)
Application.Calculate
With wkbCopy
Sh = .Worksheets.Count
For i = 3 To Sh
With .Worksheets(i)
With .UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
End With
Next i
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = StatusCalc
End With
wkbCopy.Save
End Sub