Copy data from one workbook and paste to another workbook beside the specified date

**hpo2509** · 10-12-2015, 04:42 AM

Hello Everyone,

I'm cracking my head over VBA codes that would help me, copy a set of data from a specific range in a workbook and paste it to another workbook beside the dates in a row. I quite spent some time looking for solutions but most of the answers were for sheet to sheet transfers.
Ideally what I'm trying to do is

1. Copy data from customer workbook range A2:F5000 from Sheet 1
2. Activate target workbook and Sheet 1 and search in column B for the date that is equal to a date specified in Cell A1 in the target workbook
3. Paste the data in the target workbook beside the corresponding date
4. Save and close the customer workbook.

I have my code below but the search and the paste part is my issue.

I would appreciate it if someone could help me.Thanks

Sub Import()

Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook

' make assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook

' get the customer workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)

Set customerWorkbook = Application.Workbooks.Open(customerFilename)

' copy data from customer to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)

targetSheet.Range("A2", "F50000").Value = sourceSheet.Range("A2", "F50000").Value

'should find search for a corresponding to a cell value in cell A1 in destination workbook and paste the data beside it

' Close customer workbook
customerWorkbook.Close

MsgBox "Imported"

End Sub

**davesexcel** · 10-12-2015, 05:18 AM

Attaching a sample workbook enables others to work on your problem:

To attach a sample workbook. Make sure there is just enough data to make it clear what is needed. Include BEFORE/AFTER sheets if needed to show the process you're trying to complete or automate. Remember to desensitize the data.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

To add a file to a new post

To add a file to an existing post.

**hpo2509** · 10-12-2015, 06:05 AM

Thanks Dave,

I uploaded the sample file that I'm working on. Basically the data in customer workbook will be transferred to Target workbook.

Thanks in advance.

**davesexcel** · 10-12-2015, 11:13 AM

You can edit your post to add code tags.

AA CodeTags.jpg

**hpo2509** · 10-13-2015, 02:44 AM

Anyone could help me figure out what to do?

Sub Import()

Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook

' make assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook

' get the customer workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)

Set customerWorkbook = Application.Workbooks.Open(customerFilename)

' copy data from customer to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)

targetSheet.Range("A2", "F50000").Value = sourceSheet.Range("A2", "F50000").Value

'should find search for a corresponding to a cell value in cell A1 in destination workbook and paste the data beside it

' Close customer workbook
customerWorkbook.Close

MsgBox "Imported"

End Sub

thanks

**davesexcel** · 10-13-2015, 05:28 AM

Try this,

Sub Import()

    Dim customerBook As Workbook
    Dim filter As String
    Dim caption As String
    Dim customerFilename As String
    Dim customerWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim TargetRng As Range
    Dim FindRng As Range, crng As Range
    Dim FoundRng As Range

    Set targetWorkbook = ThisWorkbook
    Set targetSheet = targetWorkbook.Worksheets(1)
    Set FindRng = targetSheet.Range("A1")
    Set crng = targetSheet.Columns("B:B").SpecialCells(xlCellTypeConstants, 23).Find(what:=FindRng, lookat:=xlWhole)

    filter = "Text files (*.xlsx),*.xlsx"
    caption = "Please Select an input file "
    customerFilename = Application.GetOpenFilename(filter, , caption)

    If customerFilename <> "" Then
        Workbooks.Open Filename:=customerFilename
        Set customerWorkbook = ActiveWorkbook
    Else: MsgBox "Nothing Selected"
    End If

    Set sourceSheet = customerWorkbook.Worksheets(1)
    Set FoundRng = sourceSheet.Columns("B:B").SpecialCells(xlCellTypeConstants, 23).Find(what:=FindRng, lookat:=xlWhole)

    If Not FoundRng Is Nothing Then
        r = FoundRng.Row
        targetSheet.Range(targetSheet.Cells(crng.Row, "C"), targetSheet.Cells(crng.Row, "H")).Value = _
        Range(Cells(r, "C"), Cells(r, "H")).Value
    Else: MsgBox "Not Found"
        Exit Sub
    End If

    customerWorkbook.Close Save = True
    MsgBox "Imported"

End Sub

**hpo2509** · 10-13-2015, 04:24 PM

Hi Dave,

thanks so much works fine, quick question how to I change the code to include the data from the other dates?
such as include 15 October data and onward?

14-10-2015 04-01-53.png

**davesexcel** · 10-13-2015, 08:55 PM

What other dates are you referring to? There is only 1 date in A1

**hpo2509** · 10-14-2015, 01:12 AM

Originally Posted by davesexcel

What other dates are you referring to? There is only 1 date in A1

Apologies for not being specific. What I mean was i need to copy allnthe data from the date in A1 and beyond. So if the date is 14 october data for 14 october and beyond will.copied ro the target sheet.

**hpo2509** · 10-20-2015, 01:04 PM

Hi Dave,

Any solution to the last request. I will be forever grateful to you if this will be solved.

Thanks in advance

**davesexcel** · 10-25-2015, 10:47 AM

This should do it.



Sub DoItWell()
    Dim wb As Workbook, bK As Workbook
    Dim ws As Worksheet, SH As Worksheet
    Dim f As Range
    Dim rng As Range, rng1 As Range, a As Range, c As Range
    Dim LstRw1 As Long, Lstrw2 As Long
    Application.ScreenUpdating = 0
    Set wb = Workbooks.Open("C:\Users\Dave\Downloads\Customer Workbooks.xlsx")
    Set bK = ThisWorkbook
    Set ws = wb.Sheets(1)
    Set SH = bK.Sheets(1)
    Set f = SH.Range("A1")

    LstRw1 = SH.Cells(SH.Rows.Count, "B").End(xlUp).Row
    Lstrw2 = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row


    ws.Range("B:B").AutoFilter Field:=1, Criteria1:=">=" & f
    SH.Range("B:B").AutoFilter Field:=1, Criteria1:=">=" & f

    Set rng = ws.Range("B1:B" & Lstrw2).SpecialCells(xlCellTypeVisible)
    Set rng1 = SH.Range("B1:B" & LstRw1).SpecialCells(xlCellTypeVisible)

    For Each c In rng1.Cells
        For Each a In rng.Cells
            If a = c Then
                SH.Range(SH.Cells(c.Row, "C"), SH.Cells(c.Row, "H")).Value = ws.Range(ws.Cells(a.Row, "C"), ws.Cells(a.Row, "H")).Value
            End If
        Next a
    Next c

    ws.AutoFilterMode = 0
    SH.AutoFilterMode = 0
    wb.Close True
End Sub

**hpo2509** · 10-28-2015, 10:15 AM

Hi Dave,
Sorry to be a bit annoying, but the code seems to copy only the column headers and not the data.

Thanks again.

**davesexcel** · 10-28-2015, 11:48 PM

I would say it copies the column headers as well, not only the headers.

Change the ranges to B2 instead of B1

Copy data from one workbook and paste to another workbook beside the specified date

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Copy data from one workbook and paste to another workbook beside the specified date

Re: Copy data from one workbook and paste to another workbook beside the specified date

Re: Copy data from one workbook and paste to another workbook beside the specified date

Re: Copy data from one workbook and paste to another workbook beside the specified date

Re: Copy data from one workbook and paste to another workbook beside the specified date

Re: Copy data from one workbook and paste to another workbook beside the specified date

Re: Copy data from one workbook and paste to another workbook beside the specified date

Re: Copy data from one workbook and paste to another workbook beside the specified date

Re: Copy data from one workbook and paste to another workbook beside the specified date

Re: Copy data from one workbook and paste to another workbook beside the specified date

Re: Copy data from one workbook and paste to another workbook beside the specified date

Re: Copy data from one workbook and paste to another workbook beside the specified date

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] Macro to find data in source workbook and copy paste to target workbook

[SOLVED] Code to copy data from a closed workbook and paste in active workbook using named range.

[SOLVED] Copy and Paste data from .xlsm workbook to .xls workbook

copy data from open workbook then paste data into different workbook based on user input

[SOLVED] Copy/paste data from one workbook to another but workbook name variable

Macro to copy data from one workbook and paste it from second row of another workbook.

[SOLVED] Selecting data from 1 workbook to copy and paste to a 2nd workbook

Bookmarks

Bookmarks

Posting Permissions