Hi Ad,
You can give the following code a try:
Sub RunMe()
Dim sSheet, dSheet As Worksheet
Dim x, y As Integer
'Source and Destination sheets. Adjust to match yours.
Set sSheet = Sheets("Sheet1")
Set dSheet = Sheets("Sheet2")
x = 5
sSheet.Range("A5:D" & sSheet.Range("A5").End(xlDown).Row).Copy dSheet.Range("A5")
dSheet.Range("A5:D" & dSheet.Range("A5").End(xlDown).Row).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlNo
For Each cell In dSheet.Range("A5:A" & Range("A" & Rows.Count).End(xlUp).Row)
Do
If cell.Value = sSheet.Range("A" & x).Value Then
y = 5
Do
If sSheet.Range("E" & x).Value = dSheet.Cells(2, y).Value Then Exit Do
y = y + 6
Loop Until dSheet.Cells(2, y).Value = vbNullString
sSheet.Range(sSheet.Cells(x, "F"), sSheet.Cells(x, "K")).Copy dSheet.Cells(cell.Row, y)
End If
x = x + 1
Loop Until cell.Value <> sSheet.Range("A" & x).Value
Next cell
End Sub
Best regards,
Trowa