Worksheets Not Being Properly Copied

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,562
Office Version
  1. 365
  2. 2016
Platform
  1. 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.

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:

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
The code behaving differently in same Office versions in different computers is probably because of the Service Pack version installed (being there, my friend). I recommend installing SP3 in both computers. If this is what is causing the problem I don't know, but I'll try to take a look
 
Upvote 0
Hi marcelocbd, thanks for the quick reply.
I stand corrected on my work version. Its Excel 2010 SP1. (14.0.7132.5000).
 
Upvote 0
I can't seem to find anything wrong with your code at all. I made some tests in my computer and it seems fine. I don't imagine anything other then the SP version. You should try that first
 
Upvote 0
Upvote 0
Nope. Wasn't the answer. Work computer updated to latest SP2 version.
 
Upvote 0
OK ... I have solved that mystery.
Turns out the sheets to be copied cannot be hidden. With them being unhidden they copy ok.

Thanks marcelocbd for your help. If anything, my work computer is updated!
 
Upvote 0
I've had a look, but there is a load of highly verbose code that seems to obfuscate the point of the code.
So the bit you are dealing with is as follows:
Rich (BB code):
    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
To understand it I had to try compact it a bit. At the beginning your code dimensioned a large number of variables that could
easily be placed into arrays and then variables expanded by simple code like this:

Rich (BB code):
''' Original CODE
Dim ws_masterwksh As Worksheet, ws_vh As Worksheet, ws_wkmaster As Worksheet, ws_servicewksh As Worksheet, ws_wkservices As Worksheet

' 5 variables .... many lines later...

    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")

'''The newly condensed code...

Dim sports15b As Workbook, Sht As Variant
'2 variables.

    Sht = Array(ThisWorkbook, "MasterWKSH", "ServicesWKSH", "VAR_HOLD") ' Sht contains all the information about ThisWorkbook. _
    This simplifies understanding the code from here on...

    Set sports15b = Sht(0)
    
    With sports15b

        Set ws_masterwksh = .Sheets(Sht(1))
        Set ws_servicewksh = .Sheets(Sht(2))
        Set ws_vh = .Sheets(Sht(3))

    End With

This example shows what it could look like:
Rich (BB code):
    Workbooks("Sports15b.xlsm").Worksheets("ServicesWKSH") ' Original
    Sports15b.sheets(sht(2)) ' Condensed

I must say thank you to you, because you have made me consider a new approach to my workflow.
I have learned a new way to dimension variables in less code and less time, consequently. Your code is intricate and very compicated which makes it harder to trace a fault.

My original tutor said this: Plan, simplify, Implement, goto 0.
The next tutor taught me to replace msgbox with Debug.print "..." & chr(13)

If you are able to simplify your loquascious code into something more eloquent, then finding the fault will be far more simple. By using arrays you will find that changing a single variable will cascade through
your entire project more transparently.

The answer to your particular problem, it may be easier to add a new sheet, name it and then copy and paste the data from the old sheet than simply transferring the entire page.
That way the data remains intact and it doesn't really matter about other issues like service packs etc...

Well done for creating what you have: that's dedication and will pay off in the end. I admire the sheer effort and time you've put into getting it right.
 
Upvote 0
OK ... I have solved that mystery.
Turns out the sheets to be copied cannot be hidden. With them being unhidden they copy ok.

Thanks marcelocbd for your help. If anything, my work computer is updated!

No problem, even tho I couldn't help you much. Glad you figured things out.
And take a look in Rhodie reply, Really good piece of advice there, that I will also implement in my codes.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,213
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top