Sub Create_Report()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, f As Range
Dim k As Long
Application.ScreenUpdating = False
Set sh1 = Sheets("[COLOR=#ff0000]Data[/COLOR]")
Set sh2 = Sheets("[COLOR=#ff0000]LOOK UP"[/COLOR])
'
sh2.Range("B2", Cells(Rows.Count, Columns.Count)).ClearContents
For Each c In sh2.Range("A2", sh2.Range("A" & Rows.Count).End(xlUp))
k = Columns("N").Column
Set f = sh1.Range("B:B").Find(c.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
sh2.Cells(c.Row, "B").Resize(1, 12).Value = sh1.Cells(f.Row, "A").Resize(1, 12).Value
For j = Columns("R").Column To Columns("AN").Column
If sh1.Cells(f.Row, j).Value = "" Then
sh2.Cells(c.Row, k).Value = sh1.Cells(1, j).Value
k = k + 1
End If
Next
End If
Next
Application.ScreenUpdating = True
MsgBox "End"
End Sub