VBA copy sheets as values only

[horizonflame]

Morning All,

I have tabs “Info”, “Dash”, “Projects”, Dates” and “DatesInfo”.

I would like to copy them to a new workbook with the same formatting but values only to remove the formulas. I would like to save the file name as ‘Performance Dashboard - DD/MM/YYYY’ with today’s date in the same directory as the original.

Many thanks

 

[mumps]

Try:

Sub CopySheets()
    Application.ScreenUpdating = False
    Dim srcWB As Workbook, desWB As Workbook, ws As Worksheet
    Set srcWB = ThisWorkbook
    Set desWB = Workbooks.Add(1)
    With srcWB
        For Each ws In .Sheets(Array("Info", "Dash", "Projects", "Dates", "DatesInfo"))
            With desWB
                ws.Copy .Sheets(.Sheets.Count)
                ActiveSheet.UsedRange.Cells.Value = ActiveSheet.UsedRange.Cells.Value
            End With
        Next ws
    End With
    Application.DisplayAlerts = False
    Sheets("Sheet1").Delete
    Application.DisplayAlerts = True
    ActiveWorkbook.SaveAs Filename:=srcWB.Path & Application.PathSeparator & "Performance Dashboard - " & Format(Date, "dd-mm-yyyy")
    Application.ScreenUpdating = True
End Sub

 

[horizonflame]

Hi @mumps, thank you.

That's seems to do the job but I forgot that some of the sheets have protected cells, and I would like to carry over the protection too.

The error is" Run-time error '1004': The cell or chart you're trying to change is on a protected sheet".

Many thanks again.

 

[mumps]

Are the sheets password protected? Are they all protected or just some? If some, which ones are protected?

 

[horizonflame]

Yes, all sheets have some locked cells and there is a password to unlock.

Thanks

 

[mumps]

Try the following macro. Replace "MyPassword" (in red) with your actual password.

Sub CopySheets()
    Application.ScreenUpdating = False
    Dim srcWB As Workbook, desWB As Workbook, ws As Worksheet
    Set srcWB = ThisWorkbook
    Set desWB = Workbooks.Add(1)
    With srcWB
        For Each ws In .Sheets(Array("Info", "Dash", "Projects", "Dates", "DatesInfo"))
            ws.Unprotect Password:="[COLOR="#FF0000"]MyPassword[/COLOR]"
            With desWB
                ws.Copy .Sheets(.Sheets.Count)
                ActiveSheet.UsedRange.Cells.Value = ActiveSheet.UsedRange.Cells.Value
            End With
            ws.Protect Password:="[COLOR="#FF0000"]MyPassword[/COLOR]"
        Next ws
    End With
    Application.DisplayAlerts = False
    Sheets("Sheet1").Delete
    Application.DisplayAlerts = True
    ActiveWorkbook.SaveAs Filename:=srcWB.Path & Application.PathSeparator & "Performance Dashboard - " & Format(Date, "dd-mm-yyyy")
    Application.ScreenUpdating = True
End Sub