To solve for unique values only is first priority.

try:

Sub Test()
Dim LRow As Long, i As Long, n As Long
Dim varData As Variant, varTmp As Variant
Dim myDic As Object

With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
varData = .Range("A2:A" & LRow)
'unique values
Set myDic = CreateObject("Scripting.Dictionary")
For i = LBound(varData) To UBound(varData)
myDic(varData(i, 1)) = varData(i, 1)
Next
varTmp = myDic.items
End With

n = 2
For i = LBound(varTmp) To UBound(varTmp)
Sheets("Sheet2").Cells(n, 1).Resize(7) = varTmp(i)
n = n + 7
Next
End Sub


Regards
Claus B.
--


You're the Boss! Perfect.

Thanks, Claus.

Howard