实现的效果：

代码：

Sub test()
Dim cell As Range

Range("F3:I10000").Clear

lastRow = Cells(Rows.Count, "f").End(xlUp).Row
'MsgBox lastrow
For Each cell In Range("a1:a21")
    If Not cell.Comment Is Nothing Then
        'MsgBox cell.Value
        lastRow = lastRow + 1
        cell.Resize(1, 4).Copy Destination:=Cells(lastRow, "f")
    End If
Next cell

End Sub