Ark68
Well-known Member
- Joined
- Mar 23, 2004
- Messages
- 4,562
- Office Version
- 365
- 2016
- Platform
- Windows
The code below opens a second workbook (if not already open), and creates, names and saves a third.
Upon creation of the third workbook, which is hidden, two worksheets are copied from the 1st (main) workbook to the newly created workbook (workbook 3).
But I am having problems copying the sheets to the 3rd workbook. With the line in red below, I encounter the error ""Cannot rename a sheet to the same name as another sheet...". It would appear that my code is attempting to copy the sheet and paste and rename it back to the same workbook instead of the newly created 3rd workbook.
Upon creation of the third workbook, which is hidden, two worksheets are copied from the 1st (main) workbook to the newly created workbook (workbook 3).
But I am having problems copying the sheets to the 3rd workbook. With the line in red below, I encounter the error ""Cannot rename a sheet to the same name as another sheet...". It would appear that my code is attempting to copy the sheet and paste and rename it back to the same workbook instead of the newly created 3rd workbook.
Rich (BB code):
Sub master_worksheet()
Dim wb_base As Workbook, wksh_book As Workbook
Dim ws_masterwksh As Worksheet, ws_servicewksh As Worksheet, ws_vh As Worksheet, ws_core As Worksheet, ws_corestaff As Worksheet, wksh_book As Workbook, ws_wkservices As Worksheet
Dim fac_rng As Range as range, rcore As Range
Dim qfile2 As String, st_srchfn As String, dir_name As String, path2 As String, ws_name As String
Dim vParts
Dim norec As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set ws_masterwksh = Workbooks("sports15b.xlsm").Worksheets("MasterWKSH")
Set ws_servicewksh = Workbooks("sports15b.xlsm").Worksheets("ServicesWKSH")
Set ws_vh = Workbooks("sports15b.xlsm").Worksheets("VAR_HOLD")
Set fac_rng = Workbooks("Sports15b.xlsm").Worksheets("Facilities").Range("A:G")
qfile2 = ws_vh.Range("B4")
st_srchfn = "H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\" & qfile2
dir_name = Format(ws_vh.Range("B2"), "ddd dd-mmm-yy")
path2 = "H:\PWS\Parks\Parks Operations\Sports\Sports15\WORKORDERS\" & dir_name
ws_name = "WS " & Format(ws_vh.Range("B2"), "dd-mmm-yy") & ".xlsx"
On Local Error Resume Next
MkDir path2 'create directory
vParts = Split(st_srchfn, "\") 'open datasource if not open already. Define workbook.
On Error Resume Next
Set wb_base = Workbooks(vParts(UBound(vParts)))
If Err.Number Then Set wb_base = Workbooks.Open(st_srchfn)
On Error GoTo 0
On Error Resume Next 'define datasource worksheets. Hide workbook.
Windows(wb_base.Name).Visible = False
On Error GoTo 0
Set ws_core = wb_base.Worksheets("CORE")
Set ws_corestaff = wb_base.Worksheets("Staff")
norec = WorksheetFunction.Count(ws_core.Range("C:C")) 'last row in source (ws_core)
Set rcore = ws_core.Range("A2:EE" & norec + 1) 'source range (ws_core)
Set wksh_book = Workbooks.Add 'create and save new workbook, hide it
wksh_book.SaveAs Filename:=path2 & "\" & ws_name
wksh_book.Windows(1).Visible = False
With ws_servicewksh 'copy services worksheet from main book to book created above. Define new (services) worksheet.
.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Services"
Set ws_wkservices = wksh_book.Worksheets("Services")
End With
With ws_masterwksh 'copy master worksheet from main book to book created above. Define new (master) worksheet.
.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Master"
Set ws_wkmaster = wksh_book.Worksheets("Master")
End With
With wksh_book 'delete redundant worksheets created during new workbook creation
On Error Resume Next
.Sheets("Sheet1").Delete
.Sheets("Sheet2").Delete
.Sheets("Sheet3").Delete
On Error GoTo 0
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
wksh_book.Windows(1).Visible = True
End Sub