You can use this code -
Option Explicit
Dim lrow As Long
Dim i As Long
Dim j As Long
Sub vlookup_report()
Application.ScreenUpdating = False
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Output"
With Worksheets("Output")
Worksheets("Sheet1").Range("A1:D1").Copy .Range("A1")
Worksheets("Sheet2").Range("B1:S1").Copy .Range("E1")
lrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet1").Range("A2:A" & lrow).Copy .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
lrow = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet2").Range("A2:A" & lrow).Copy .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Columns("$A:$A").RemoveDuplicates Columns:=1, Header:=xlYes
lrow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To 22
For j = 2 To lrow
On Error Resume Next
If i <= 4 Then
.Cells(j, i).Value = Application.WorksheetFunction.VLookup(Range("A" & j), Worksheets("Sheet1").Columns("A:D"), i, False)
Else
.Cells(j, i).Value = Application.WorksheetFunction.VLookup(Range("A" & j), Worksheets("Sheet2").Columns("A:S"), i - 3, False)
End If
Next j
Next i
End With
Application.ScreenUpdating = True
End Sub
Bookmarks