Copy data between two workbooks

[shn.ea]

Hi, we are trying to build a script that will copy data from two worksheets in a workbook to the corresponding worksheets in another workbook. I am using Excel 2007 on Windows Vista.



The old workbooks have data sorted by date from 2007 to 2009 while the new workbooks have data from 2007 to 2011, and we have to copy the overlapping period - we added two more years. There are thousands of workbooks, and in the process of adding the additional years, we also made changes to the other sheets, one being a chart. All workbooks contain patient samples from hospitals. In this particular example we are looking to copy C7, O7, C8, Q8, C10, F16:AE18, F20:AE20, and F25:AE25.

The old workbooks have different names (i.e. MedRec-LTC_1_HospitalName_0909_OLD.xls) but the new workbooks have a generic name (i.e. MedRec-LTC_1_Generic_NEW.xls).

My initial idea was to hardcode the new workbook name and determine the active workbook name. I tried to only copy the first cell of interest first, but the code does not work:

Sub MedRecLTC2()
    
    Dim WbSource As Workbooks
    Dim WbDestination As Workbooks
    
    Set WbSource = ActiveWorkbook.Name
    Set WbDestination = Workbooks("MedRec-LTC_1_Generic_NEW.xls")
        
    Workbooks("WbSource").Sheets("Data Entry Sheet").Range("O7").Copy
    Workbooks("WbDestination").Sheets("Data Entrey Sheet").Range("O7").Paste
    
End Sub

I tried variations that gave limited success; when I changed the detection of the source, I got it to copy the right cell:

    Source = ActiveWorkbook.Name
        
    Workbooks(Source).Sheets("Data Entry Sheet").Range("O7").Copy

But code did not work for the next step... I patched the code from various bits and pieces of info from various forums, so that makes me think I did not understand the right combination of steps to take; I am not viewing this in the right manner.

Any suggestions or direction?

 

[shn.ea]

That works! Well almost.

    'Header
    WbDestination.Sheets("Data Entry Sheet").Range("O7") = WbSource.Sheets("Data Entry Sheet").Range("O7")
    WbDestination.Sheets("Data Entry Sheet").Range("Q8") = WbSource.Sheets("Data Entry Sheet").Range("Q8")
    WbDestination.Sheets("Data Entry Sheet").Range("C10") = WbSource.Sheets("Data Entry Sheet").Range("C10")
    
    'Data
    WbDestination.Sheets("Data Entry Sheet").Range("F16:AE18") = WbSource.Sheets("Data Entry Sheet").Range("F16:AE18")
    WbDestination.Sheets("Data Entry Sheet").Range("F20:AE20") = WbSource.Sheets("Data Entry Sheet").Range("F20:AE20")
    WbDestination.Sheets("Data Entry Sheet").Range("F23:AE23") = WbSource.Sheets("Data Entry Sheet").Range("F23:AE23")
    
    'Submitted By
    WbDestination.Sheets("Submitted By").Range("C2:F27") = WbSource.Sheets("Submitted By").Range("C2:F27")

I set-up the ranges, it copies the "header" cells, but does NOT copy the "data" and "submitted by" ranges. Any thoughts?

 

[Jobowo]

What was I thinking? So sorry, not paying complete attention. The 'equates' works for single cells but yes, you do have to use copy/paste for ranges. I think I have such a distaste for the unintuitive paste format that I try to avoid it at all costs...even when I shouldn't.

Note that, looking more closely at your code, I see that it is better to set worksheet objects to start out, to shorten the references. Let's see how this works. I haven't created workbooks and sheets with your names so haven't tested this finally but it should be close enough to get you to the finish line.

Again, apologies for wrong turn.

Sub MedRecLTC()
    
    Dim ShSource As Worksheet
    Dim ShDestination As Worksheet
    Dim shName As String
    Dim Destination As String
    
    shName = "Data Entry Sheet"
      
    ChDir (ThisWorkbook.Path)
    Destination = "MedRec-LTC_1_Generic_NEW.xls"
    Workbooks.Open (Destination)
    
    Set ShSource = ThisWorkbook.Sheets(shName)
    Set ShDestination = Workbooks(Destination).Sheets(shName)

    With ShDestination
        'Header
        .Range("O7") = ShSource.Range("O7")
        .Range("Q8") = ShSource.Range("Q8")
        .Range("C10") = ShSource.Range("C10")
        'Data
        ShSource.Range("F16:AE18").Copy
            .Paste Destination:=.Range("F16:AE18")
        ShSource.Range("F20:AE20").Copy
            .Paste Destination:=.Range("F20:AE20")
        ShSource.Range("F23:AE23").Copy
            .Paste Destination:=.Range("F23:AE23")
        'Submitted By
        ShSource.Range("C2:F27").Copy
            .Paste Destination:=.Range("C2:F27")
    End With
End Sub

 

[shn.ea]

Thank you, that worked! Here is the final code I used:

Sub MedRecLTC1()

    Dim WbSource As Workbook
    Dim WbDestination As Workbook
    Dim Destination As String
        
    Set WbSource = ThisWorkbook
        
    ChDir (ThisWorkbook.Path)
    Destination = "MedRec-LTC_1_1.0 Mean Number of Undocumented Intentional Discrepancies in Long Term Care"
    Workbooks.Open (Destination)
    
    Set WbDestination = Workbooks(Destination)
    
    'Header Facility Name
    WbDestination.Sheets("Data Entry Sheet").Range("C7") = WbSource.Sheets("Data Entry Sheet").Range("C7")
    'Header Team
    WbDestination.Sheets("Data Entry Sheet").Range("O7") = WbSource.Sheets("Data Entry Sheet").Range("O7")
    'Header Health Region
    WbDestination.Sheets("Data Entry Sheet").Range("C8") = WbSource.Sheets("Data Entry Sheet").Range("C8")
    'Header Point of Transfer
    WbDestination.Sheets("Data Entry Sheet").Range("Q8") = WbSource.Sheets("Data Entry Sheet").Range("Q8")
    'Header Sample
    WbDestination.Sheets("Data Entry Sheet").Range("C10") = WbSource.Sheets("Data Entry Sheet").Range("C10")
        
    'Data
    WbSource.Sheets("Data Entry Sheet").Range("F16:AE18").Copy
        WbDestination.Sheets("Data Entry Sheet").Paste Destination:=WbDestination.Sheets("Data Entry Sheet").Range("F16:AE18")
    WbSource.Sheets("Data Entry Sheet").Range("F20:AE20").Copy
        WbDestination.Sheets("Data Entry Sheet").Paste Destination:=WbDestination.Sheets("Data Entry Sheet").Range("F20:AE20")
    WbSource.Sheets("Data Entry Sheet").Range("F23:AE23").Copy
        WbDestination.Sheets("Data Entry Sheet").Paste Destination:=WbDestination.Sheets("Data Entry Sheet").Range("F23:AE23")
        
    'Submitted By
    WbSource.Sheets("Submitted By").Range("C2:F27").Copy
        WbDestination.Sheets("Submitted By").Paste Destination:=WbDestination.Sheets("Submitted By").Range("C2:F27")

End Sub

 

[Jobowo]

Well done! No doubt you have your reasons for using the longer expressions but whatever works and is best understood. Again, apologies for the misdirection earlier.