Ark68
Well-known Member
- Joined
- Mar 23, 2004
- Messages
- 4,562
- Office Version
- 365
- 2016
- Platform
- Windows
I am having an issue with copying a worksheet from one workbook to a second ....
Here is the module's code leading up to where the worksheets are copied (in blue). After that is just code relying on the sheets having been properly copied.
The new workbook is created, and saved with the appropriate name. The source workbook does have the populated worksheets "MasterWKSH" and "ServicesWKSH" in place to be copied.
"ServicesWKSH" is copied to the new workbook (wksh_book), and is named appropriately. However, it is empty. None of it's contents from the source has been copied.
When "MasterWKSH" is copied over, all that I can see happening is the worksheet in the new workbook previously named "Services" is now "Master", and it too is empty.
I would have expected that two individual sheets to have been copied verbatim from the source.
What is interesting, is this code works flawlessly on my home computer where I did most of the development of this application. However, on my work computer, this is what happens. Both computers running Excel 2013. What is oddly different between how the code runs between the two computers, is when my home computer creates the new workbook, it comes with 3 blank worksheets (which I end up deleting in this code). The work computer doesn't seem to do that. Whether that is a contributing factor I don't know.
Here is the module's code leading up to where the worksheets are copied (in blue). After that is just code relying on the sheets having been properly copied.
Rich (BB code):
Sub master_worksheet()
Dim wb_base As Workbook, wksh_book As Workbook, newbook As Workbook, trgt_wksh As Worksheet, ka As Worksheet
Dim ws_core As Worksheet, ws_corestaff As Worksheet
Dim ws_masterwksh As Worksheet, ws_vh As Worksheet, ws_wkmaster As Worksheet, ws_servicewksh As Worksheet, ws_wkservices As Worksheet
Dim qfile2 As String, st_srchfn As String, fac5 As String, crew_sig As String, crew_prep As String, crew_groom As String, crew_lon As String, crew_loff As String, crew_close As String
Dim dir_name As String, path2 As String, ws_name As String, pristaff
Dim norec As Long, rws2add As Long, i As Long, y As Long, SR As Long, lrow As Long, base_row As Double
Dim r As Range, fac_rng As Range, r_body As Range, c As Range, rcore As Range, rdata As Range
Dim CList(1 To 7) As String, sReport(1 To 8) As String, arr2, arr4
Dim s_rpt As String, rng_body As Range, cell As Range, s_crew As String, s_crew_name As String, s_crew2 As String, s_crew_name2 As String
Dim llastrow As Long, x As Long, no_srvs As Long, row_no As Long, dt_rid As Long, dt_rid_row As Long, rw_start
Dim srv_cln As Long, ref_cm As Long, jl As Long, cntr As Long, d As Range, h As Long
Dim l_adj_crew As String, r_adj_crew As String, ll As String, s_sdd As String
Dim tg_RID As Long, l_clm As Long, r_clm As Long, src_RID_row As Long, l_clm_val As String, r_clm_val As String, lcolm As Long
Dim prp_type As String, dts_div As String, dts_lwr As String, dts_upr As String, ka2 As String
Dim cm As Long, u As Long
Dim RID As Long, fma_row As Long, j As Long
Dim vParts
Application.ScreenUpdating = False
Application.DisplayAlerts = False
sReport(1) = "CUE"
sReport(2) = "CUL"
sReport(3) = "HPE"
sReport(4) = "HPL"
sReport(5) = "RPE"
sReport(6) = "RPL"
sReport(7) = "WPE"
sReport(8) = "WPL"
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
'Select Case Err.Number
' Case 0
' MsgBox "created directory"
'Case 75
' MsgBox "Directory already exists"
' Case Else
' MsgBox Err.Number & " -" & Err.Description
'End Select
vParts = Split(st_srchfn, "\")
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
Windows(wb_base.Name).Visible = True
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
wksh_book.SaveAs Filename:=path2 & "\" & ws_name
'Application.DisplayAlerts = False
'With Workbooks.Add
' .SaveAs Filename:=path2 & "\" & ws_name
' Set wksh_book = Workbooks(ws_name)
'End With
'Application.DisplayAlerts = True
With wksh_book 'create services worksheet
MsgBox .Name
Workbooks("Sports15b.xlsm").Worksheets("ServicesWKSH").Copy After:=.Sheets(.Sheets.Count)
.ActiveSheet.Name = "Services"
Set ws_wkservices = .Worksheets("Services")
'create master worksheet
Workbooks("Sports15b.xlsm").Worksheets("MasterWKSH").Copy After:=.Sheets(.Sheets.Count)
.ActiveSheet.Name = "Master"
Set ws_wkmaster = .Worksheets("Master")
End With
'With wksh_book
' On Error Resume Next
' .Sheets("Sheet1").Delete
' .Sheets("Sheet2").Delete
' .Sheets("Sheet3").Delete
' On Error GoTo 0
' End With
With ws_wkmaster 'build master worksheet
.Range("M1") = ws_vh.Range("B2")
.Range("M4") = "Min Time"
.Range("O4") = "ALL"
.Range("P4") = "Max Time"
.Range("M5") = Format(WorksheetFunction.min(ws_core.Range("O:O")), "h:mmA/P")
.Range("P5") = Format(WorksheetFunction.Max(ws_core.Range("O:O")), "h:mmA/P")
'insert blank rows
rws2add = norec - 1
Set r = .Range("A13")
Do
.Range(r.offset(1, 0), r.offset(rws2add, 0)).EntireRow.Insert
Set r = Cells(r.row + rws2add + 1, 1)
If r.offset(1, 0) = "" Then Exit Do
Loop
... more code
The new workbook is created, and saved with the appropriate name. The source workbook does have the populated worksheets "MasterWKSH" and "ServicesWKSH" in place to be copied.
"ServicesWKSH" is copied to the new workbook (wksh_book), and is named appropriately. However, it is empty. None of it's contents from the source has been copied.
When "MasterWKSH" is copied over, all that I can see happening is the worksheet in the new workbook previously named "Services" is now "Master", and it too is empty.
I would have expected that two individual sheets to have been copied verbatim from the source.
What is interesting, is this code works flawlessly on my home computer where I did most of the development of this application. However, on my work computer, this is what happens. Both computers running Excel 2013. What is oddly different between how the code runs between the two computers, is when my home computer creates the new workbook, it comes with 3 blank worksheets (which I end up deleting in this code). The work computer doesn't seem to do that. Whether that is a contributing factor I don't know.
Last edited: