How to get specific data in a column by only using data from one cell

Question

I've a lot of sales orders, I've to fill out with a lot of data from different excel workbooks and worksheets. So I need an macro which can do it for me. I have 4 different Excel workbooks. 1 where the data have to be inserted and 3 where I have to get the data from. All the Excel workbooks have the sales orders listed,

So the macro has to scan for each Sales order in each workbook and then get specific data from the workbooks.

This is an example of the workbook where I paste the data.

Here's an example for a workbook where I have to copy the data.

So it has to copy:

And then paste it into the workbook where I have to paste the data.

If anyone could either give me a somewhere to begin or some piece of code, I would be more than happy!

Answer 1

EDITED SOLUTION BELOW. Not the prettiest code and there's probably a better way to do it, but it should do what you want it to in a roundabout way.

Copy this macro into a module in your master book that you're copying TO and save it somewhere as an XLSM file.

Place all 3 of your sheets (or as many as you want) that you want to copy FROM within a different folder somewhere and then insert that file location where noted in the macro.

This should loop through every file in the specified location, grab all used cells except the header row and paste them into the next available rows in Sheet2 on your master book.

Then the macro will run a vlookup on the copied over data against the sales order numbers and paste special to turn them back to values. Finally it will clear Sheet2 ready for next time you run it.

Obviously, if your sheets are named something else you can amend, or refer to them by number, but it should give you a starting point at least.

Sub CopyTheData()

Dim Folder As String
Dim File As Variant
Dim wbk As Workbook
Dim This As Worksheet, That As Worksheet

Folder = "[FOLDER LOCATION HERE]"
File = Dir(Folder & "*.*")
Set This = ThisWorkbook.Sheets(1)
Set That = ThisWorkbook.Sheets(2)

Application.ScreenUpdating = False

While (File <> "")
    Set wbk = Workbooks.Open(Folder & File)


    With wbk
        Range("A1").Select
        Selection.CurrentRegion.Select
        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
        Selection.Copy Destination:=That.Range("B65536").End(xlUp)(2).Offset(0, -1)
    End With

    wbk.Close

    File = Dir
Wend

    This.Activate
    This.Range("B2", Range("A2").End(xlDown).Offset(0, 1)).Formula = "=VLOOKUP(A2, Sheet2!$A:$H,2,FALSE)"
    This.Range("C2", Range("A2").End(xlDown).Offset(0, 2)).Formula = "=VLOOKUP(A2,Sheet2!$A:$H,4,FALSE)"
    This.Range("D2", Range("A2").End(xlDown).Offset(0, 3)).Formula = "=VLOOKUP(A2,Sheet2!$A:$H,6,FALSE)"
    This.Range("E2", Range("A2").End(xlDown).Offset(0, 4)).Formula = "=VLOOKUP(A2,Sheet2!$A:$H,8,FALSE)"

    With This.Range("B2", Range("A2").End(xlDown).Offset(0, 4))
        .Copy
        .PasteSpecial Paste:=xlPasteValues
    End With

    Columns("D:E").NumberFormat = "m/d/yyyy"

    That.Cells.ClearContents


Application.ScreenUpdating = True

End Sub