Check and Copy sheets from one wb to another

jimayers

Board Regular
Joined
Nov 14, 2010
Messages
99
hello - I have been working on how to check and copy (would love to merge or sync) sheets from one workbook to another. The reason is that I have to input data on a PC that is stripped and/or blocked from running macros, then work on the data in a different office that allows macros.

So I have been entering the data on a non-macro enabled workbook, then opening an entirely different WB (when I get the chance on a pc that is allowed to run it) which has a macro to open the orignial. With both open I can use macros to manipulate the data on both sheets.

BUT this has become problematic so I am trying to write a macro to copy the data, including checking and adding new sheets from the non-enabled to the enabled macro PC.
Here is what I got (after several attempts at other ideas)
Code:
Sub makeCopy_ClosedWorksheet()
    ' turn off features
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    '  constants
    Const PATH = "\\network_somewhere\Shared\Education\Teachers\Myers\Excel Folder\"
    Const FILE = PATH & "Student List.xlsx"
 
    '  variables
    Dim thisWb, otherWb As Workbook
    Dim thisWs, otherWs, tws, ows As Worksheet
    Dim i As Integer:   i = 0
    Dim C As Integer:   C = 0
    Dim thisRg, otherRg As Range
   
    '  set-up
    On Error Resume Next
    Set thisWb = Application.ActiveWorkbook
    Set otherWb = Workbooks("Student List")
    If otherWb Is Nothing Then
        Set otherWb = Application.Workbooks.Open(FILE)
    End If
On Error GoTo 0 'canceling On Error command from above
   
    For Each ows In otherWb.Worksheets
        For Each tws In thisWb.Worksheets
             C = C + 1
                    If tws.Name = ows.Name Then
                     MsgBox (tws.Name & " - " & ows.Name & ". Looped through " & C & " times.")
                        Set thisRg = tws.Range("A1:E100")
                        Set otherRg = ows.Range("A1:E100")
                        otherRg.Copy (thisRg) 'copy wrksheet contents
                    Else
                        tws.Copy after:=Workbooks("TEST4i.xlsm").Sheets(C)
                        MsgBox (tws.Name & " sheet made.")                       
                    End If
           Next tws            
    Next ows
   
 
    ' reset variable
    i = 0:    C = 0
    ' save this workbook
    thisWb.Save
 
    ' clean up
    Set otherWs = Nothing
    otherWb.Close
    Set otherWb = Nothing
    Set thisWb = Nothing
    Set thisWs = Nothing
 
    ' restore features
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.Calculate
 
End Sub

I would appreciate any help - thanks - Jim A
 
Last edited:

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Forum statistics

Threads
1,136,641
Messages
5,676,954
Members
419,663
Latest member
Xbox_360

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
Top