Making a new copy with only values - Excel VBA - excel

Question

I have to write a code that will make copy of two sheets into new workbook. However, I receve error message and the values do not show..
Public Sub CopySheetAndRename()
Dim newName As String
On Error Resume Next
newName = InputBox("Enter the name for the copied worksheet")
If newName <> "" Then
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = newName
End If
End Sub
Sub SaveSheets()
Application.DisplayAlerts = False
Dim myFile
Dim myCount
Dim actSheet
Dim i
Dim WsTabelle As Worksheet
'mypath = InputBox("Enter the path", "Save to...", "C:\temp")
mypath = "C:\temp"
ChDrive mypath
ChDir mypath
Sheets("Fertigstellungsgrad aktuell").Select
Sheets("Fertigstellungsgrad aktuell").Copy Before:=Sheets("Fertigstellungsgrad aktuell")
Sheets("Fertigstellungsgrad aktuell").Select
Sheets("Fertigstellungsgrad aktuell (2)").Name = "Fertigstellungsgrad xx.xx.xx"
ActiveWorkbook.SaveAs Filename:= _
"C:\temp\Bearbeitungsstatus.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
' Löschen überflüssiger Sheets
For Each WsTabelle In Sheets
With WsTabelle
' Dein Makro, Cells und Range mit Punkt
actSheet = .Name
If .Name = "Fertigstellungsgrad xx.xx.xx" Then
' mache nichts
actSheet = .Name
ElseIf .Name = "Übersicht AP-Verbrauch" Then
' mache nichts
actSheet = .Name
Else
WsTabelle.Delete
End If
End With
Next WsTabelle
ActiveWorkbook.SaveAs Filename:= _
" C:\temp \Bearbeitungsstatus.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
Public Sub SubstitudeFieldValues()
Sheets("Fertigstellungsgrad xx.xx.xx").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
FinalCol = Cells(1, Columns.Count).End(xlToLeft).Column
' Loop through each row
For Col = 1 To FinalCol
colTitle = Cells(1, Col).Value
If colTitle = "K1" Or _
colTitle = "K2" Or _
colTitle = "K3" Or _
colTitle = "S1" Or _
colTitle = "S2" Or _
colTitle = "S3" Or _
colTitle = "P1" Or _
colTitle = "P2" Or _
colTitle = "P3" Or _
colTitle = "T1" Or _
colTitle = "T2" Or _
colTitle = "T3" Or _
colTitle = "A1" Or _
colTitle = "A2" Or _
colTitle = "D1" Or _
colTitle = "D2" Then
For x = 2 To FinalRow
wert = Cells(x, Col)
If wert <> Leer Then
'Range(Cells(x, Col), Cells(x, Col)).Select
Cells(x, Col).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next x
End If
Next Col
End Sub
The original task is to make copy of two sheets in the new workbook.
Making a copy of "Fertigstellungsgrad" with ability of rename (It should be called "Fertigstellungsgrad xx.xx.xx" - Date.Month.Year) and the copy should contain only values. "Übersicht AP-Verbrauch"(this one should stay the same, without any changes)
https://i.stack.imgur.com/Soxq7.png
Kind regards, Mario

Answer 1

There are spaces in the filenames in Sub SaveSheets()
I changed:
ActiveWorkbook.SaveAs Filename:= _
" C:\temp \Bearbeitungsstatus.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
to
ActiveWorkbook.SaveAs Filename:= _
"C:\temp\Bearbeitungsstatus.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
and I could save the file.
I modified the code below from an IF / FOR to a CASE SELECT and modified the range for FinalRow variable to be the current column used range. It looks like your For / Next statement in the sub is pseudo code so I haven't made any changes to it.
Public Sub SubstitudeFieldValues()
Sheets("Fertigstellungsgrad xx.xx.xx").Select
' Find the last row of data
'FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
FinalCol = Cells(1, Columns.Count).End(xlToLeft).Column
' Loop through each row
For Col = 1 To FinalCol
colTitle = Cells(1, Col).Value
Select Case colTitle
Case "K1", "K2", "K3", "S1", "S2", "S3", "P1", "P2", "P3", "T1", "T2", "T3", "A1", "A2", "D1", "D2"
FinalRow = Range(colTitle).End(xlDown).Row
Case else
goto NotFound
End Select
For x = 2 To FinalRow
wert = Cells(x, Col)
If wert <> Leer Then
'Range(Cells(x, Col), Cells(x, Col)).Select
Cells(x, Col).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next x
NotFound:
Next Col
End Sub
To set the name of the new sheet to include the date, you can change your code in SaveSheets() from:
Sheets("Fertigstellungsgrad aktuell (2)").Name = "Fertigstellungsgrad xx.xx.xx"
to
Sheets("Fertigstellungsgrad aktuell (2)").Name = "Fertigstellungsgrad " & Format(Now(), "dd.mm.yy")
Your subsequent Select statement in Sub SubstitudeFieldValues() would become:
Public Sub SubstitudeFieldValues()
Sheets("Fertigstellungsgrad " & Format(Now(), "dd.mm.yy").Select