This code will find a particular word of the last cell of a column then from another sheet, it will copy some cells and paste them to the empty cells.

 

When I use the macro ?

To fill empty cells with the data from another sheet that match a specific value.

 

How to create the macro ?

Read How to create, edit, hide and select a macro in an excel report

 

How to create the button to associate it with the macro ?

Read How to create a button and associated it to a macro in an excel report

 

How is the macro ?

Copy the code below and paste it into your macro. You will see my comments in green if exist so follow the help to adapt to your need.

Sub test()
Dim j As Long
Dim lCol As Long, lRow As Long
Dim x1 As Range, x2 As Range
' to find value last cell of a column, change 6 by your ID column, i.e. column F = 6
lCol = Cells(Rows.Count, 6).Column
lRow = Cells(Rows.Count, 6).End(xlUp).Row
MyVal1 = Range(Cells(lRow, 6), Cells(lRow, lCol))
MyVal2 = Range(Cells(lRow, 6), Cells(lRow, lCol))
' change 0 by 1 if first to paste next row and not same row
j = 0
' change google by your value to find
If MyVal1 = "google" Or MyVal1 = "Google" Then
' change sheet1 by your sheet to copy and H3:H5 by your range
For Each x1 In Worksheets("Sheet1").Range("H3:H5")
' copy only value higher than 1
' copy everything, change x1.Value > 1 by Not x1.Value = ""
If x1.Value > 1 Then
' change E by your column to paste
' optional change ActiveSheet by Worksheets("Sheet2")
x1.Offset(0, 0).Copy ActiveSheet.Range("E" & Rows.Count).End(xlUp).Offset(1, 0)
' copy value of the left cell i.e. column I
' if copy value of the right cell i.e. column G, change (0, 1) by (0, -1)
x1.Offset(0, 1).Copy
' change D by your column to paste
ActiveSheet.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
' change 1 if not column A and 3 if not column C to copy from until
' change A if not column A to paste from
ActiveSheet.Range(Cells(Rows.Count, 1).End(xlUp).Offset(0, 0), Cells(Rows.Count, 3).End(xlUp).Offset(0, 0)).Copy ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(j, 0)
' change 6 if not column F to copy from until
' change F if not column F to paste from
ActiveSheet.Range(Cells(Rows.Count, 6).End(xlUp).Offset(0, 0), Cells(Rows.Count, 6).End(xlUp).Offset(0, 0)).Copy ActiveSheet.Range("F" & Rows.Count).End(xlUp).Offset(j, 0)
j = 0 + 1
Else
End If
Next
Else
' change explorer by your value to find
If MyVal2 = "explorer" Or MyVal2 = "Explorer" Then
' change sheet1 by your sheet to copy and J3:J5 by your range
For Each x2 In Worksheets("Sheet1").Range("J3:J5")
If x2.Value > 1 Then
x2.Offset(0, 0).Copy ActiveSheet.Range("E" & Rows.Count).End(xlUp).Offset(1, 0)
x2.Offset(0, 1).Copy
ActiveSheet.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ActiveSheet.Range(Cells(Rows.Count, 1).End(xlUp).Offset(0, 0), Cells(Rows.Count, 3).End(xlUp).Offset(0, 0)).Copy ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(j, 0)
ActiveSheet.Range(Cells(Rows.Count, 6).End(xlUp).Offset(0, 0), Cells(Rows.Count, 6).End(xlUp).Offset(0, 0)).Copy ActiveSheet.Range("F" & Rows.Count).End(xlUp).Offset(j, 0)
j = 0 + 1
Else
End If
Next
Else
End If
End If
End Sub

To use this code, I have 2 sheets, “sheet1” and “sheet2”. What I want, it is to fill the empty cells of the “sheet2” based on the value of the last cell of the “type” column, in this example, it is “google”.

On the “sheet1”, I have those data:

About how to extract the “unique value list”, read this article “List unique values then combine in one single cell all data using a macro in an excel report”. For your report, you may want to combine those 2 codes into 1 single one.