Copy & Paste Data Into Specific Column by Matching Date

[Friction8]

Hello guru's, I need your insight to help me create a MACRO that can go & get data in an Excel file located on one drive, copy it and then paste this data to another Excel file in another drive where the date matches.

I've looked for examples, but I can not decern which one I'll need to help me in this scenario. Your help is greatly appreciated! ray:
Thanks again!

OS: Windows XP
Excel Version: Excel 2007
File Locations:<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
Source: L:\traffic\Pass Down Note\ Transportation Pass Down Master.xlsm
Target: Z:\share\Daily Inbound\Daily_IB_ADEL_ATS.xlsx
The Data’s Copy and Paste Parameter:<o></o>
Source File date: is always found on the Tab “Exec Sum” and is always in only one Cell, “C3”
(cell “C3” is over written everyday)
And where this date matches in the target file
Target File date: Column “A” (range A2:A60k+) in the Tab “0530_Data”
The Data I want:
Source File Data Set A: found in Cell “C14” on the “Exec Sum” Tab
Source File Data Set B: found in Cell “C15” on the “Exec Sum” Tab
Source File Data Set C: found in cell “C19” on the “Exec Sum” Tab
Where I want the data to go:
Copy “Data Set A” and Paste to Target, Tab “0530_Data”, Column “F” where date matches
Copy “Data Set B” and Paste to Target, Tab “0530_Data”, Column “G” where date matches
Copy “Data Set C” and Paste to Target, Tab “0530_Data”, Column “H” where date matches
Additional Actions

Save and Close Target File

 

[Datsmart]

Put together some test code to help you.
Works with some test workbooks I created.

Sub CopyFromClosedWorkBookToClosedWorkBook()
Dim pth As String
Dim pth2 As String
Dim SourceRange, TargetRange

    With Application              'Turn ScreenUpDating & Calculation ON
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

'Assign Variables for Target and Source workbooks
    SourcePath = "L:\traffic\Pass Down Note\"
    swb = "Transportation Pass Down Master.xlsm"
    TargetPath = "Z:\share\Daily Inbound\"
    twb = "Daily_IB_ADEL_ATS.xlsx"
    SourceWB = SourcePath & swb
    TargetWB = TargetPath & twb
    'Assign variables for Target and Source Sheetnames
    ss = "Exec Sum"
    ts = "0530_Data"
On Error GoTo NoBook
'====================================================
    'Open Source workbook
    Workbooks.Open SourceWB, Password:="", WriteResPassword:="", ReadOnly:=False
    wbs = ActiveWorkbook.Name
    
    'Assign Source Date to find
    Date2Find = Sheets(ss).Range("C3").Value
    
    'Open Target workbook
    Workbooks.Open TargetWB, Password:="", WriteResPassword:="", ReadOnly:=False
    wbt = ActiveWorkbook.Name
'====================================================
'Copy Data
    'Assign variable for LastRow of Target Sheet
    LR = Sheets(ts).Cells(Sheets(ts).Rows.Count, 1).End(xlUp).Row
    'Assign Start Row of Source sheet
    'sr = Sheets(ts).Cells.Find(What:="Contact Type", After:=ActiveCell, LookAt:=xlWhole).Row + 2
    lr2 = Sheets(ts).Cells(Sheets(ts).Rows.Count, "A").End(xlUp).Row
    'Assign Range for Source
    Set Rng1 = Sheets(ts).Range(Sheets(ts).Cells(1, 1), Sheets(ts).Cells(lr2, 1))
    'Loop through items in Rng1
        For Each a In Rng1
            If Range("A" & a.Row).Value = Date2Find Then
                Range("F" & a.Row).Value = Workbooks(wbs).Sheets(ss).Range("C14").Value
                Range("G" & a.Row).Value = Workbooks(wbs).Sheets(ss).Range("C15").Value
                Range("H" & a.Row).Value = Workbooks(wbs).Sheets(ss).Range("C19").Value
            End If
        Next a
'====================================================
    'Close Target workbook
    Workbooks(wbt).Close SaveChanges:=True 'Close Workbook w/Save
    
    'Close Source workbook
    Workbooks(wbs).Close SaveChanges:=False  'Close Workbook w/o Save
'====================================================
    
    With Application              'Turn ScreenUpDating & Calculation ON
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With

GoTo TheEnd

NoBook:
    With Application              'Turn ScreenUpDating & Calculation ON
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With

    MsgBox "Wrong Path and/or WorkBook Name..."

TheEnd:
End Sub

 

[Friction8]

John, YOU ARE A BEAST!

This worked beautifully & will come in handy for other reports down the road! I also like the fact you put some code in there for passwords, read only & save changes.

Thanks again! Take care - Nick

 

[Friction8]

Just wanted to give an update on this. Yes the macro worked, if the file you were updating was last saved on the sheet that was being updated. If it wasn't, no update went through, so I added an 'ActivateSheet' command. Here is where I put it, but thanks so much again!

Workbooks.Open TargetWB, ReadOnly:=False 'removed these, not needed Password:="", WriteResPassword:="",
wbt = ActiveWorkbook.Name
'====================================================
'Copy Data
'Activate Sheet
Sheets("0530_Data").Activate
'Assign variable for LastRow of Target Sheet
LR = Sheets(ts).Cells(Sheets(ts).Rows.Count, 1).End(xlUp).Row