Macro to find data in source workbook and copy paste to target workbook

Dear All,

I have a source workbook from which I will copy sales data from onto a template workbook to create a sales analysis. The source workbook has dropdown menus at the top of each column which allow me to filter out the blocks of data I need.

How hard would it be to write a macro that can do this for me?

I have attached an example of the source and target workbooks.

For the purpose of an example, lets as I want the macro to find all the lines in the source workbook that read "AREA 1" in column A, "SALES" in column D, and "2013 in column F. Having identified those lines I then want the data in columns B & C copies across to the target workbook entitled 'Sales Analysis Template' and pasted onto the '2013' sheet in columns A & B. And then the figures in columns G-R on the source workbook copied across to the 2013 sheet on the target workbook, and pasted into columns C-N (i.e. the sales figures for January to December copied across and pasted in the relevant columns).

I then need to repeat the process for lines that match "2014" in column F of the source workbook and copy the same information across but pasted into the respective columns in the target workbook, this time on the 2014 sheet, the column layouts are the same as with the 2013 sheet.

Finally I would like to then identify how many blank lines are left over on the 2014 sheet and delete them all the way down to line 1665, retaining the summary section that exists on the template below this.

This is a simplified example of what I am attempting to do, I am confident that I will be able to adapt appropriate examples to fit the real data, and hopefully learn something in the process.

If anyone fancies having a go at helping me out with this, I would be most grateful.

Many thanks,

Dave.

Maybe:

Sub D_Lovell()
Dim Source As Worksheet
Dim i As Long
Set Source = Workbooks("SOURCEDATAEXAMPLE.xls").Sheets("SALESEXPORT")
Source.Activate
For i = 2 To Source.Range("A" & Rows.count).End(3)(1).Row
    If Range("A" & i) = "AREA 1" And Range("D" & i) = "SALES" And Range("F" & i) = 2013 Then
        Range(Cells(i, "B"), Cells(i, "C")).Copy Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("A" & Rows.count).End(3)(2)
        Range(Cells(i, "G"), Cells(i, "R")).Copy Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("C" & Rows.count).End(3)(2)
    ElseIf Range("A" & i) = "AREA 1" And Range("D" & i) = "SALES" And Range("F" & i) = 2014 Then
        Range(Cells(i, "B"), Cells(i, "C")).Copy Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Range("A" & Rows.count).End(3)(2)
        Range(Cells(i, "G"), Cells(i, "R")).Copy Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Range("C" & Rows.count).End(3)(2)
    End If
Next i
Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Activate
Range("A" & Rows.count).End(3)(2).Select
Range(ActiveCell, Cells(1665, "A")).EntireRow.Delete
End Sub

Hi,

Thanks for this, it's a good start. This puts the correct data into the correct place on the 2013 sheet, but not the 2014 sheet for some reason.

I need for the 2014 figures for those same customers to also be pasted onto the 2014 sheet, so that we end up with the same customer's figures on both sheets and on the same rows, only difference is which year the figures are taken from.

Also this deleted the part of the 2014 sheet that I actually want to retain. It's all the blank rows left over above row 1665 that need to be deleted, while retaining what is below line 1665. So after the figures are pasted onto the 2014 sheet, delete rows from that sheet starting 1 row below the pasted data, going down to row 1665. Do not delete rows below 1665.

Trying to adapt the code but I'm not very experienced at this yet.

Any further help would be appreciated.

Many thanks,

Dave.

See if this works any better.

Sub D_Lovell()
Dim Source As Worksheet
Dim i As Long
Set Source = Workbooks("SOURCEDATAEXAMPLE.xls").Sheets("SALESEXPORT")
Source.Activate
For i = 2 To Source.Range("A" & Rows.count).End(3)(1).Row
    If Range("A" & i) = "AREA 1" And Range("D" & i) = "SALES" And Range("F" & i) = 2013 Then
        Range(Cells(i, "B"), Cells(i, "C")).Copy Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("A" & Rows.count).End(3)(2)
        Range(Cells(i, "G"), Cells(i, "R")).Copy Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("C" & Rows.count).End(3)(2)
    ElseIf Range("A" & i) = "AREA 1" And Range("D" & i) = "SALES" And Range("F" & i) = 2014 Then
        Range(Cells(i, "B"), Cells(i, "C")).Copy Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Range("A" & Rows.count).End(3)(2)
        Range(Cells(i, "G"), Cells(i, "R")).Copy Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Range("C" & Rows.count).End(3)(2)
    End If
Next i
Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Activate
Range(Cells(1, "A"), Cells(1664, "A")).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

I think you may have merged cell in Sheet 2014 which may cause problems. Is that the case?

It was not my intention to merge cells, I have checked though and am pretty sure there are none but it does have various formulas and conditional formatting already in place if that matters, it was created as a template to manually paste this data onto.

This script does now retain the bottom section of the 2014 sheet as I described. It still doesn't paste the data correctly onto the 2014 sheet.

There is something else I realised I haven't mentioned yet. Ideally this needs to consider what is the current month, and copy the 2014 figures upto the current month, but not including the current month, and for this to work correctly at whatever time of the year it is used. Is that possible?

I have attached a further example that shows what it ideally should look like after running the macro, this is assuming it is used now with regards to the point I have made above.

When doing this, I pasted the values only onto the template, maybe that is important as well.

When tested, it looked like it pasted into Columns AB of 2014 correctly, but not into C. If that is your finding let me know.

Yes it did copy the data into columns A&B of the 2014 sheet but it was underneath the summary section at the bottom, rather than being positioned on the same rows as on the 2013 sheet, as if the pasting position starts from bellow the last rows to have data already in them.

I thought that was what you wanted? Did you want to paste over the data in 2014?

OK. Now I think I understand, try:

Sub D_Lovell()
Dim Source As Worksheet
Dim i As Long
Dim x As Long
Dim y As Long
Set Source = Workbooks("SOURCEDATAEXAMPLE.xls").Sheets("SALESEXPORT")
Source.Activate
For i = 2 To Source.Range("A" & Rows.count).End(3)(1).Row
    If Range("A" & i) = "AREA 1" And Range("D" & i) = "SALES" And Range("F" & i) = 2013 Then
        x = Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("A" & Rows.count).End(3)(2).Row
        y = Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("C" & Rows.count).End(3)(2).Row
        Range(Cells(i, "B"), Cells(i, "C")).Copy Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("A" & x)
        Range(Cells(i, "G"), Cells(i, "R")).Copy Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("C" & y)
    ElseIf Range("A" & i) = "AREA 1" And Range("D" & i) = "SALES" And Range("F" & i) = 2014 Then
        Range(Cells(i, "B"), Cells(i, "C")).Copy Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Range("A" & x)
        Range(Cells(i, "G"), Cells(i, "R")).Copy Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Range("C" & y)
    End If
Next i
Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Activate
Range(Cells(1, "A"), Cells(1664, "A")).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Yes this copies the data into the correct places and deletes left over rows, that is exactly what I meant. This is a very helpful example for getting me started off.

One last thing on this one, how can we paste the data as if we were choosing 'paste values' when doing it manually in Excel, so that it doesn't paste over my cell formatting on the template?

Perhaps:

Sub D_Lovell()
Dim Source As Worksheet
Dim i As Long
Dim x As Long
Dim y As Long
Set Source = Workbooks("SOURCEDATAEXAMPLE.xls").Sheets("SALESEXPORT")
Source.Activate
For i = 2 To Source.Range("A" & Rows.count).End(3)(1).Row
    If Range("A" & i) = "AREA 1" And Range("D" & i) = "SALES" And Range("F" & i) = 2013 Then
        x = Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("A" & Rows.count).End(3)(2).Row
        y = Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("C" & Rows.count).End(3)(2).Row
        Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range(Cells(x, "A"), Cells(x, "B")).Value = Range(Cells(i, "B"), Cells(i, "C")).Value
        Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range(Cells(y, "C"), Cells(y, "N")).Value = Range(Cells(i, "G"), Cells(i, "R")).Value
    ElseIf Range("A" & i) = "AREA 1" And Range("D" & i) = "SALES" And Range("F" & i) = 2014 Then
        Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Range(Cells(x, "A"), Cells(x, "B")).Value = Range(Cells(i, "B"), Cells(i, "C")).Value
        Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Range(Cells(y, "C"), Cells(y, "N")).Value = Range(Cells(i, "G"), Cells(i, "R")).Value
    End If
Next i
Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Activate
Range(Cells(1, "A"), Cells(1664, "A")).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

This line returns run-time error 1004, object-defined or application-defined error

Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range(Cells(x, "A"), Cells(x, "B")).Value = Range(Cells(i, "B"), Cells(i, "C")).Value

Try this:

Sub D_Lovell()
Dim Source As Worksheet
Dim i As Long
Dim x As Long
Dim y As Long
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set Source = Workbooks("SOURCEDATAEXAMPLE.xls").Sheets("SALESEXPORT")
Source.Activate
For i = 2 To Source.Range("A" & Rows.count).End(3)(1).Row
    If Range("A" & i) = "AREA 1" And Range("D" & i) = "SALES" And Range("F" & i) = 2013 Then
        x = Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("A" & Rows.count).End(3)(2).Row
        y = Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("C" & Rows.count).End(3)(2).Row
        Range(Cells(i, "B"), Cells(i, "C")).Copy
            Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("A" & x).PasteSpecial xlPasteValues
        Range(Cells(i, "G"), Cells(i, "R")).Copy
            Workbooks("Sales Analysis Template.xlsm").Sheets("2013").Range("C" & y).PasteSpecial xlPasteValues
    ElseIf Range("A" & i) = "AREA 1" And Range("D" & i) = "SALES" And Range("F" & i) = 2014 Then
        Range(Cells(i, "B"), Cells(i, "C")).Copy
            Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Range("A" & x).PasteSpecial xlPasteValues
        Range(Cells(i, "G"), Cells(i, "R")).Copy
            Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Range("C" & y).PasteSpecial xlPasteValues
    End If
Next i
Workbooks("Sales Analysis Template.xlsm").Sheets("2014").Activate
Range(Cells(1, "A"), Cells(1664, "A")).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Very helpful indeed, this does exactly what I meant and is useful learning material for me. I have adapted it to work with my actual data layout rather than the example I posted and got it working fine. There are other issues that I will need to ask for help with but I will post the next one in a separate thread that focus' on that particular issue, it will be to do with excluding the months of the year that haven't occurred yet when copying sales data to the 2014 sheet. Since this thread was about finding and copying data from a source workbook to a target one, you have completely answered the question that I posted in this threat and I feel I should mark it as solved. Again thanks very much for your help.

Best regards,

You're welcome. Glad to help out and thanks for the feedback.

Post deleted