pulling one coumn & related data from one file to other in excel

[ssbhatban]

Dear friends

I have two excel files
1. master
2. marks

There are multiple columns in each file . . now i am creating one more file called combine. my reference column is barcode column in both master & marks file. i want to bring all the data in master file to combine file as well as data from marks file to combine file . data from master file should come as it is , but the barcode in marks file will not be arranged as in master file. i want it to get arranged as in master file when it is imported to combine file and same way marks & bundle columns should also should get arranged in combine file

i am attaching image files & excel sample file for reference. i will be having hundreds of data. i will be having all the file in the same folder
what is the best & simple way to do it

thanks in advance

 

[mumps]

Make sure that the combine file has a blank sheet named "Combined". Place this macro in the combine file. Change the sheet names (in red) and the file names (in blue) to suit your needs. Make sure that the master and marks workbooks are open before you run the macro.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim master As Workbook, marks As Workbook, combined As Worksheet
    Dim Arr As Variant, i As Long, srcRng As Range, x As Long
    Set master = Workbooks("Master.xlsx")
    Set marks = Workbooks("Marks.xlsx")
    Set combined = ThisWorkbook.Sheets("Combined")
    With marks.Sheets("Sheet1")
        Arr = .Range("B2", .Range("B" & .Rows.Count).End(xlUp)).Resize(, 3).Value
        .Range("B1:D1").Copy combined.Range("J1")
    End With
    With combined
        master.Sheets("Sheet1").UsedRange.Cells.Copy .Range("A1")
        Set srcRng = .Range("H2", .Range("H" & .Rows.Count).End(xlUp))
        For i = LBound(Arr) To UBound(Arr)
            x = Application.Match(Arr(i, 1), srcRng, 0)
            If Not IsError(x) Then
                .Range("J" & x).Resize(, 3).Value = Array(Arr(i, 1), Arr(i, 2), Arr(i, 3))
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

 

[ssbhatban]

Dear friend

Thank you very much. working like a charm. you have saved my day.
I am facing only one small problem. the values pulled from sheet 'marks' is getting arranged properly as per requirement but going one row up & header is not getting copied. any solutions to that. i am attaching the image
i have placed the code n a module as shown i another image. is it ok
can u just explain me exactly how this is functioning. i am getting a bit confused
thanks

 

[ssbhatban]

Dear Friend

in addition to the above problem. one more small problem i encountered is when there are blank cell or rows or some other characters which are not matching with another file in any file of the two files. it is giving the following error message.
find the attached images

 

[mumps]

This should take care of the blank cells problem.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim master As Workbook, marks As Workbook, combined As Worksheet
    Dim Arr As Variant, i As Long, srcRng As Range, x As Long
    Set master = Workbooks("Master.xlsx")
    Set marks = Workbooks("Marks.xlsx")
    Set combined = ThisWorkbook.Sheets("Combined")
    With marks.Sheets("Sheet1")
        Arr = .Range("B2", .Range("B" & .Rows.Count).End(xlUp)).Resize(, 3).Value
        .Range("B1:D1").Copy combined.Range("J1")
    End With
    With combined
        master.Sheets("Sheet1").UsedRange.Cells.Copy .Range("A1")
        Set srcRng = .Range("H2", .Range("H" & .Rows.Count).End(xlUp))
        For i = LBound(Arr) To UBound(Arr)
            If Arr(i, 1) <> "" Then
                x = Application.Match(Arr(i, 1), srcRng, 0)
                If Not IsError(x) Then
                    .Range("J" & x).Resize(, 3).Value = Array(Arr(i, 1), Arr(i, 2), Arr(i, 3))
                End If
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

Do you have headers in the marks workbook in cells B1, C1 and D1?

 

[ssbhatban]

Yes have headers in all the three cells B1, C1, D1

 

[mumps]

This line of code should be copying the headers in B1, C1, D1 from the marks to the combined:

.Range("B1:D1").Copy combined.Range("J1")

Is this not happening?

 

[ssbhatban]

No i. Checked that it is not happening when data is pulled from marks file . But it is working when data is pulled from master file

 

[mumps]

Try this version:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim master As Workbook, marks As Workbook, combined As Worksheet
    Dim Arr As Variant, i As Long, srcRng As Range, x As Long
    Set master = Workbooks("Master.xlsx")
    Set marks = Workbooks("Marks.xlsx")
    Set combined = ThisWorkbook.Sheets("Combined")
    With marks.Sheets("Sheet1")
        Arr = .Range("B2", .Range("B" & .Rows.Count).End(xlUp)).Resize(, 3).Value
    End With
    With combined
        master.Sheets("Sheet1").UsedRange.Cells.Copy .Range("A1")
        marks.Sheets("Sheet1").Range("B1:D1").Copy .Range("J1")
        Set srcRng = .Range("H2", .Range("H" & .Rows.Count).End(xlUp))
        For i = LBound(Arr) To UBound(Arr)
            If Arr(i, 1) <> "" Then
                x = Application.Match(Arr(i, 1), srcRng, 0)
                If Not IsError(x) Then
                    .Range("J" & x).Resize(, 3).Value = Array(Arr(i, 1), Arr(i, 2), Arr(i, 3))
                End If
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

 

[ssbhatban]

Dear friend
That blank cell problem is solved, thank you very much , but the row shifting up problem still persists, I tried all combinations but no use