Hi and thanks in advance,
I have a workbook with a protected sheet. I run some code that Saves As into a new workbook removing all formulas but leaving the values and formats in tact. I would like to leave the sheet in the original wkb protected but remove the protection from the sheet in the Saved As wkb? Not sure how or where to slot in the unprotect code?
Here is my code thus far:
I have a workbook with a protected sheet. I run some code that Saves As into a new workbook removing all formulas but leaving the values and formats in tact. I would like to leave the sheet in the original wkb protected but remove the protection from the sheet in the Saved As wkb? Not sure how or where to slot in the unprotect code?
Here is my code thus far:
Code:
[SIZE=3][COLOR=#000000][FONT=Times New Roman]Sub ExportWorkbook()[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Dim varFileName As Variant[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Dim strRestrictedName As String[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] On Error GoTo Err_Handler[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] strRestrictedName = ActiveWorkbook.Name[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Application.EnableEvents = False[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] varFileName = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path & "\", fileFilter:="Microsoft Office Excel Workbook (*.xls), *.xls")[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] varFileName = Mid$(varFileName, InStrRev(varFileName, "\") + 1)[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] If varFileName <> False Then[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] If UCase$(varFileName) <> UCase$(strRestrictedName) Then[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] ActiveWorkbook.SaveAs varFileName[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Application.EnableEvents = True[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] FormulasToValues (varFileName)[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] ActiveWorkbook.Save[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] MsgBox "Done"[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Else[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] MsgBox "Invalid File Name", vbCritical, "Stop"[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] End If[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Else[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] ' Cancelled Save As dialog[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] End If[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Application.EnableEvents = True[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]Err_Exit:[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Application.EnableEvents = True[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Exit Sub[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]Err_Handler:[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Select Case Err[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Case 1004 ' Cancelled overwrite of existing file in Save As msgbox[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] ' do nothing[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Case Else[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] MsgBox Err & " " & Err.Description[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] End Select[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] GoTo Err_Exit[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]End Sub[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]Sub FormulasToValues(WkbName As String)[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Dim ws As Worksheet[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Dim wkb As Workbook[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Application.ScreenUpdating = False[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Application.Calculation = xlCalculationManual[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Set wkb = Application.Workbooks(WkbName)[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] For Each ws In wkb.Worksheets[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] With ws[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] .Activate[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] On Error Resume Next[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] .ShowAllData[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] .AutoFilterMode = False[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Worksheets(ws).ShowAllData = True[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] On Error GoTo 0[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] .Cells.Select[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Selection.Copy[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Selection.PasteSpecial xlPasteValuesAndNumberFormats[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Selection.PasteSpecial xlFormats[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Selection.PasteSpecial xlPasteColumnWidths[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] End With[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] ws.Range("A1").Select[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Application.CutCopyMode = False[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Next[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Sheets(1).Activate[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Application.Calculation = xlCalculationAutomatic[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] Application.ScreenUpdating = True[/FONT][/COLOR][/SIZE]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]