Question

我在多列中列出数据并将其放入单个列中（A）。如果B列中有数据，它会抓取该数据，将其粘贴在A列数据的末尾，然后返回并删除现在为空的列B，这会将所有其他列移到一列上，所以现在有数据再次列B，直到除了A列之外没有其他数据列。我目前的方法是列出下面相同代码的多个块，这些块明显效率不高，迟早会代码会破裂。任何建议表示赞赏!!

Range("B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Selection.End(xlUp).Select
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, -1).Range("A1").Select

Answer 1

我喜欢Christmas007的回答。我也想分享这个解决方案：

Sub MoveIt()
Dim mysht As Worksheet
Set mysht = ActiveSheet
Set myrng = mysht.UsedRange


nextrow = mysht.Cells(mysht.Rows.Count, 1).End(xlUp).Row

For i = 2 To myrng.Columns.Count

lastColrow = myrng.Cells(mysht.Rows.Count, i).End(xlUp).Row
If lastColrow <> 1 Or myrng.Cells(1, i) <> "" Then
    For j = 1 To lastColrow
        nextrow = nextrow + 1
        mysht.Cells(nextrow, 1) = myrng.Cells(j, i)

    Next j
End If
Next i

Range(myrng.Columns(2), myrng.Columns(myrng.Columns.Count)).Clear


End Sub

我喜欢它，因为它没有使用复制，粘贴和删除功能。根据我的经验，如果您处理大型工作簿并且还需要激活工作表，这些函数会开始导致宏拖动。

Answer 2

有一种非常简单的方法可以做到这一点：

Sub MoveIt()

Dim LastRow As Long
Dim ws1 as Worksheet

Set ws1 = Sheets("Name of Sheet")

Do While (ws1.Range("B1").Value <> "")
    LastRow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row + 1
    ws1.Range("B1:B" & ws1.Range("B" & ws1.Rows.Count).End(xlUp).Row).Copy
    ws1.Range("A" & LastRow).PasteSpecial
    ws1.Range("B1").EntireColumn.Delete xlToLeft
Loop

End Sub

循环将所有列移动到一列

2 个答案: