Excelsheets incl Formeln in neue Datei kopieren
26.02.2016 17:37:46
Jan
ich habe eine Vorlage, in der per Userform Daten abgefragt werden, die dann in die entsprechenden Zellen eingefügt werden. Danach sollen alle Sheets incl komplettem Inhalt in eine neue Datei kopiert werden. Funktioniert im Groben soweit wie ich es will, nur anstatt der Formeln kopiert er nur die Werte der Zellen. Wahrscheinlich ganz einfach, aber ich komme einfach nicht weiter.
der Code:
Private Sub OKButton_Click()
If JahrTextBox = "" Then
MsgBox "Bitte das Jahr angeben. *Pflichtfeld"
Exit Sub
End If
If NameTextBox = "" Then
MsgBox "Bitte den Namen angeben. *Pflichtfeld"
Exit Sub
End If
Worksheets("Voreinstellungen").Range("C2").Value = JahrTextBox.Value
Worksheets("Voreinstellungen").Range("C3").Value = NameTextBox.Value
Worksheets("Voreinstellungen").Range("C4").Value = NummerTextBox.Value
Worksheets("Voreinstellungen").Range("C7").Value = SaldoMTextBox.Value
Worksheets("Voreinstellungen").Range("C8").Value = SaldoPTextBox.Value
Worksheets("Voreinstellungen").Range("C34").Value = TUTextBox.Value
Worksheets("Voreinstellungen").Range("C35").Value = RUTextBox.Value
Worksheets("Voreinstellungen").Range("D12:H12").Value = ArbeitszeitTextBox.Value
Worksheets("Januar").Range("D4:J34").ClearContents
Worksheets("Februar").Range("D4:J34").ClearContents
Worksheets("März").Range("D4:J34").ClearContents
Worksheets("April").Range("D4:J34").ClearContents
Worksheets("Mai").Range("D4:J34").ClearContents
Worksheets("Juni").Range("D4:J34").ClearContents
Worksheets("Juli").Range("D4:J34").ClearContents
Worksheets("August").Range("D4:J34").ClearContents
Worksheets("September").Range("D4:J34").ClearContents
Worksheets("Oktober").Range("D4:J34").ClearContents
Worksheets("November").Range("D4:J34").ClearContents
Worksheets("Dezember").Range("D4:J34").ClearContents
Dim WBS As Workbook
Dim WS As Worksheet
With Worksheets(Array("Voreinstellungen", "Feiertage", "Januar", "Februar", "März", "April", _
"Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Dezember", "Jahresübersicht", "Fahrtkosten", "Berechnungen"))
.Copy
Set WBS = ActiveWorkbook
For Each WS In WBS.Worksheets
WS.UsedRange.Value = WS.UsedRange.Value
Next WS
End With
Application.DisplayAlerts = False
Dim strPfad As String
Dim Name As String
strPfad = Environ("UserProfile") & "\Desktop\"
Name = NameTxtBox
ActiveWorkbook.SaveAs Filename:=strPfad & "Arbeitsplan -" & Name & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Unload Me
End Sub
Vielen Dank für die Unterstützung :)