I'm optimist, I'm sure this time is good for you.
The problem was that my data were shifted 5 rows above respect to yours.
The code below (should) suit your request:
<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Macro6()
<SPAN style="color:#007F00">'</SPAN>
<SPAN style="color:#007F00">' Macro6 Macro</SPAN>
<SPAN style="color:#007F00">' Macro registrata il 24/01/2005 da FSC</SPAN>
<SPAN style="color:#007F00">'</SPAN>
<SPAN style="color:#007F00">'</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> Sheet1LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, Sheet2RowPointer <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, PointerIncr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> AllRange <SPAN style="color:#00007F">As</SPAN> Range, OneCopyRange <SPAN style="color:#00007F">As</SPAN> Range
<SPAN style="color:#00007F">Dim</SPAN> CELLi <SPAN style="color:#00007F">As</SPAN> Range, RangeToCopy <SPAN style="color:#00007F">As</SPAN> Range
<SPAN style="color:#00007F">Dim</SPAN> CopyColFrom <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, CopyColTo <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> StrMarking <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#007F00">'Sheets 2 cleaning</SPAN>
Sheets(2).Cells.Delete
<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN>
Sheets(1).ShowAllData
<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0
<SPAN style="color:#007F00">'Last row index acquisition</SPAN>
Sheet1LastRow = Sheets(1).Cells(Cells.Rows.Count, 1).End(xlUp).Row
<SPAN style="color:#007F00">'Initialization of Pointer to first blank row in Sheet 2</SPAN>
Sheet2RowPointer = 1
<SPAN style="color:#007F00">'Set Columns Number to copy</SPAN>
CopyColFrom = 5 <SPAN style="color:#007F00">'First</SPAN>
CopyColTo = Sheets(1).Range("A5").End(xlToRight).Column <SPAN style="color:#007F00">'Last</SPAN>
<SPAN style="color:#007F00">'Data range acquisition</SPAN>
<SPAN style="color:#00007F">Set</SPAN> AllRange = Sheets(1).Range(Sheets(1).Range("A5"), Sheets(1).Cells(Sheet1LastRow, CopyCol<SPAN style="color:#00007F">To</SPAN>))
<SPAN style="color:#007F00">'Acquisition of all different records</SPAN>
AllRange.Columns(1).AdvancedFilter Action:=xlFilterInPlace, Unique:=<SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#00007F">Set</SPAN> OneCopyRange = AllRange.Columns(1).SpecialCells(xlCellTypeVisible)
<SPAN style="color:#007F00">'Momently clear column A cells relevant to Comments</SPAN>
<SPAN style="color:#00007F">For</SPAN> PointerIncr = 9 To Sheet1LastRow <SPAN style="color:#00007F">Step</SPAN> 5
Sheets(1).Cells(PointerIncr, 1).ClearContents
<SPAN style="color:#00007F">Next</SPAN> PointerIncr
<SPAN style="color:#007F00">'Setting of PointerIncr to be used after the copy procedure</SPAN>
PointerIncr = CopyColTo - CopyColFrom + 1
<SPAN style="color:#007F00">'Filter all different records</SPAN>
AllRange.AutoFilter
<SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> CELLi <SPAN style="color:#00007F">In</SPAN> OneCopyRange
Sheets(1).Activate
<SPAN style="color:#007F00">'Skip A1 and empty cells</SPAN>
<SPAN style="color:#00007F">If</SPAN> CELLi.Row <> 5 And Trim(CELLi) <> "" <SPAN style="color:#00007F">Then</SPAN>
AllRange.AutoFilter Field:=1, Criteria1:=CELLi
<SPAN style="color:#007F00">'Acquisition of Marking String Data</SPAN>
StrMarking = AllRange.Columns(4).SpecialCells(xlCellTypeVisible).Cells(2, 1)
<SPAN style="color:#007F00">'Range to copy acquisition</SPAN>
<SPAN style="color:#00007F">Set</SPAN> RangeToCopy = _
Range(AllRange.Columns(CopyColFrom), AllRange.Columns(CopyColTo)).SpecialCells(xlCellTypeVisible)
<SPAN style="color:#007F00">'Copy data</SPAN>
Range<SPAN style="color:#00007F">To</SPAN>Copy.Copy
Sheets(2).Activate
Sheets(2).Cells(Sheet2RowPointer, 3).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=<SPAN style="color:#00007F">True</SPAN>
Sheets(1).Range("A5").Copy Destination:=Sheets(2).Cells(Sheet2RowPointer, 1)
Sheets(1).Range("A6").Copy
Sheets(2).Range(Cells(Sheet2RowPointer + 1, 1), Cells(Sheet2RowPointer + PointerIncr - 1, 2)).PasteSpecial _
Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets(2).Range(Cells(Sheet2RowPointer + 1, 1), Cells(Sheet2RowPointer + PointerIncr - 1, 1)) = CELLi
Sheets(1).Range("D5").Copy Destination:=Sheets(2).Cells(Sheet2RowPointer, 2)
Sheets(2).Range(Cells(Sheet2RowPointer + 1, 2), Cells(Sheet2RowPointer + PointerIncr - 1, 2)) = StrMarking
<SPAN style="color:#007F00">'Increment of the pointer for next copy</SPAN>
Sheet2RowPointer = PointerIncr + Sheet2RowPointer
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Next</SPAN> CELLi
<SPAN style="color:#007F00">'Columns Width Adjustment (Autofit)</SPAN>
<SPAN style="color:#00007F">With</SPAN> Sheets(2).Columns("A:F")
.ColumnWidth = 100
.AutoFit
.Rows.AutoFit
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
Sheets(1).Activate
<SPAN style="color:#007F00">'Clear Filter</SPAN>
<SPAN style="color:#007F00">'Sheets(1).ShowAllData</SPAN>
AllRange.AutoFilter
<SPAN style="color:#007F00">'Restore column A cells relevant to Comments</SPAN>
<SPAN style="color:#00007F">For</SPAN> PointerIncr = 9 To Sheet1LastRow <SPAN style="color:#00007F">Step</SPAN> 5
Sheets(1).Cells(PointerIncr, 1) = Sheets(1).Cells(PointerIncr - 1, 1)
<SPAN style="color:#00007F">Next</SPAN> PointerIncr
Sheets(1).Activate
Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>
Ciaoooo