Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub MergeData()
- Dim wbDatabase As Workbook, wbInput As Workbook, wbMerged As Workbook
- Dim wsDatabase As Worksheet, wsInput As Worksheet, wsMerged As Worksheet
- Dim outputRow As Long, i As Long, j As Long
- Dim matchFound As Boolean
- ' Open the database and input workbooks
- Set wbDatabase = Workbooks.Open("C:\path\to\database.xlsx")
- Set wbInput = Workbooks.Open("C:\path\to\input.xlsx")
- Set wbMerged = Workbooks.Add
- ' Access the relevant sheets
- Set wsDatabase = wbDatabase.Sheets("Foglio1")
- Set wsInput = wbInput.Sheets("AssetOverview")
- Set wsMerged = wbMerged.Sheets(1)
- ' Copy header from the input file to the merged file
- wsInput.Rows(1).Copy Destination:=wsMerged.Rows(1)
- ' Initialize the starting row for the output data
- outputRow = 2
- ' Loop through each row in the input worksheet
- For i = 2 To wsInput.Cells(wsInput.Rows.Count, "B").End(xlUp).Row
- matchFound = False
- ' Search for a match in Table1 (columns B and K)
- For j = 2 To wsDatabase.Cells(wsDatabase.Rows.Count, "B").End(xlUp).Row ' Adjust if the actual table range is known
- If wsInput.Cells(i, "B").Value = wsDatabase.Cells(j, "B").Value Or wsInput.Cells(i, "B").Value = wsDatabase.Cells(j, "K").Value Then
- ' Copy the entire row from input to the merged file
- wsInput.Rows(i).Copy Destination:=wsMerged.Rows(outputRow)
- ' Append additional data from the database file (if needed)
- wsMerged.Cells(outputRow, "Z").Value = wsDatabase.Cells(j, "F").Value ' Example: copying "Genre"
- outputRow = outputRow + 1
- matchFound = True
- Exit For
- End If
- Next j
- ' Repeat the process for Table2 if needed
- Next i
- ' Save the merged workbook
- wbMerged.SaveAs "C:\path\to\final-merged-file.xlsx"
- ' Cleanup
- wbDatabase.Close SaveChanges:=False
- wbInput.Close SaveChanges:=False
- wbMerged.Close SaveChanges:=True
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
