I have written some code (adapted from another post) which will create a new workbook and then copy several sheets of just the values in the old workbook into it. The code also keeps the formatting (which is GREAT!) but it seems to fail to copy/paste the combo and check boxes that I have on the old workbook. any idea how to include them? ALSO the code for the string "NewName" returns the error : "Method 'Range' of object '_worksheet' failed. What am I doing wrong? Custname, Ploc, and wtgtype are named ranges in the worksheet 'Project Info' in the old workbook.
Private Sub USreport_Click() Dim NewName As String Dim wsNames As Variant Dim i As Integer Dim countWS As Integer Dim s As Variant Dim ws As Worksheet Dim sourceWB As Workbook Dim destWB As Workbook Set sourceWB = ThisWorkbook wsNames = Array("Cover", "Project Info", "US Template") Application.ScreenUpdating = False Application.DisplayAlerts = False '// Verifies that all worksheets exist On Error GoTo ErrCatcher For i = LBound(wsNames) To UBound(wsNames) If Sheets(wsNames(i)).Name <> "" Then i = i Next i On Error GoTo 0 Set destWB = Workbooks.Add countWS = destWB.Sheets.Count '// Copies the workbooks format and values from the source For Each s In wsNames Set ws = destWB.Sheets.Add(After:=Sheets(destWB.Worksheets.Count)) sourceWB.Sheets(s).Cells.Copy ws.Cells(1, 1).PasteSpecial Paste:=xlValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False ws.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False ws.Cells.Hyperlinks.Delete ws.Name = s Application.CutCopyMode = False Next s '// Delete worksheets that existed when new workbook was created For i = countWS To 1 Step -1 destWB.Sheets(i).Delete Next i NewName = Application.GetSaveAsFilename(InitialFileName:=Range("Custname") & " " & Range("PLOC") & " " & Range("wtgtype"), fileFilter:="Excel Files (*.xls), *.xls", Title:="testie：") destWB.SaveAs Filename:=NewName, local:=True, CreateBackup:=True, FileFormat:=xlNormal destWB.Close SaveChanges:=True ErrCatcher: Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "Specified sheets do not exist within this workbook" End Sub