Please try
Sub coo()
Dim r As Range, a, s, i As Long
Application.ScreenUpdating = False
With Intersect(Sheets("Output").[B1].CurrentRegion, Sheets("Output").Columns("B:F"))
a = .Value
.Offset(1).ClearContents
End With
For i = 2 To UBound(a)
With Sheets("Ref").[A1].CurrentRegion
.AutoFilter 1, a(i, 3)
s = Intersect(.Offset(1).SpecialCells(12), .Cells).Value
.AutoFilter
End With
With Sheets("Output").Cells(Rows.Count, 2).End(xlUp)(3)
.Cells(1, 5).Resize(UBound(s), 5) = s
.Resize(UBound(s), 5) = Application.Index(a, i, 0)
End With
Next
Sheets("Output").UsedRange.HorizontalAlignment = xlCenter
Sheets("Output").Rows(2).Delete
Application.ScreenUpdating = True
End Sub
Bookmarks