Hi!
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.
Thanks!
Tim
Code
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