Sub Copy_Filtered_Cells()
    Set from = Selection
    Set too = Application.InputBox("Select range to copy selected cells to", Type:=8)
    For Each Cell In from
        Cell.Copy
        For Each thing In too
            If thing.EntireRow.RowHeight > 0 Then
                thing.PasteSpecial
                Set too = thing.Offset(1).Resize(too.Rows.Count)
                Exit For
            End If
        Next
    Next
End Sub