[Solved] Adding Data based on Header

[bigme]

Halo friends,
kindly help me, i have two table each in different workbooks, the data in table1 will be move to table2 as a master data, since the header not exactly in same sequence how to add data from table1 to table2 based on the header? and also continuously add new data form table1 to last row in table2, thank you.

workbook1 /table1

workbook2 / table2

best regards,
bigMe

 

[Naimul Arif]

Dear bigMe,
Thanks for your query.
In response to your query to add data from table1 to table2 based on the header, I have created a table of employees' information in Sheet1 of the Employee Info workbook.



Now, I want to import the entire column of the matched header of the Employee Info workbook to the Sheet1 of the Book2 workbook.



For this purpose, apply the following VBA code.

Sub DataExtraction()

Dim CurrentSheet As Worksheet
Dim Header_Count As Integer
Dim Row_Count As Integer
Dim Column_Count As Integer

Set CurrentSheet = ThisWorkbook.Worksheets("Sheet1")

Header_Count = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlToRight)))

Workbooks.Open Filename:="C:\Users\Dell\Desktop\Arif\00. Practice\FORUM\Employee Info.xlsx"
ActiveWorkbook.Sheets(1).Activate

Row_Count = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))
Column_Count = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))


For i = 1 To Header_Count
 
  j = 1
  Do While j <= Column_Count
  
    If CurrentSheet.Cells(1, i) = ActiveSheet.Cells(1, j).Text Then
        ActiveSheet.Range(Cells(1, j), Cells(Row_Count, j)).Copy
        CurrentSheet.Cells(1, i).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        j = Column_Count
    End If
  
    j = j + 1
  
  Loop
 
Next i

ActiveWorkbook.Close savechanges:=False
CurrentSheet.Cells(2, 1).Select

End Sub

Run the code to add data from table1 to table2 based on the header.

 

[bigme]

dear Arif,
thank you for your kind help.
I just wondering, if this code also run when i have new data and want to add into the last row of existing data?

regards,
bigMe

 

[Naimul Arif]

Hello bigMe,
The code I have provided won't work when you want to add the data from table1 to the last row of existing data of table2 based on the header from one workbook to another workbook. The code will overwrite the cells from the second row of the matched header.
To make it more dynamic according to your need to add data into the last row of existing data, I have done a little modification to the previous code. The good news is it fulfills your desire.
First of all, I have created a data table with some information as the following image.
Then, I have applied the following code.

Sub DataExtraction()

Dim CurrentSheet As Worksheet
Dim Header_Count As Integer
Dim Row_Count As Integer
Dim Column_Count As Integer


Set CurrentSheet = ThisWorkbook.Worksheets("Sheet1")

Header_Count = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlToRight)))

Workbooks.Open Filename:="C:\Users\Dell\Desktop\Arif\00. Practice\FORUM\Employee Info.xlsx"
ActiveWorkbook.Sheets(1).Activate

Row_Count = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))
Column_Count = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))


For i = 1 To Header_Count
 
  j = 1
  Do While j <= Column_Count
  
    If CurrentSheet.Cells(1, i) = ActiveSheet.Cells(1, j).Text Then
        ActiveSheet.Range(Cells(2, j), Cells(Row_Count, j)).Copy
        CurrentSheet.Cells(1, i).End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        j = Column_Count
    End If
  
    j = j + 1
  
  Loop
 
Next i


ActiveWorkbook.Close savechanges:=False
CurrentSheet.Cells(2, 1).Select


End Sub

I have just modified the following line of code using Offset to add data into the last row of existing data from another workbook.


It works perfectly and returns a result like the following image.


I hope this is what you were looking for.
Best regards,
Naimul Arif

 

[bigme]

Dear Arif,
a big big thank you for your help....

regards,
bigMe

 

[shamimarita]

Dear Arif,
a big big thank you for your help....

regards,
bigMe

Dera bigMe,

We are glad to help you. Keep posting your problems.