实现的效果：

代码：

Sub test()
Dim cell As RangeRange("F3:I10000").ClearlastRow = 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.ValuelastRow = lastRow + 1cell.Resize(1, 4).Copy Destination:=Cells(lastRow, "f")End If
Next cellEnd Sub