将Excel数据复制并粘贴到一列中

我有一个300列左右的Excel 2010表。 我需要将所有数据粘贴到一列（不合并）。 除了复制一列以外，还有什么办法可以做到这一点，滚动到底部，粘贴，并重复每一列？

Answer 1

试试这个（你可能需要改变; ）：

Answer 2

你可以使用下面的代码。 它会将所有值粘贴到列A ：

 Sub test() Dim lastCol As Long, lastRowA As Long, lastRow As Long, i As Long 'find last non empty column number' lastCol = Cells(1, Columns.Count).End(xlToLeft).Column 'loop through all columns, starting from column B' For i = 2 To lastCol 'find last non empty row number in column A' lastRowA = Cells(Rows.Count, "A").End(xlUp).Row 'find last non empty row number in another column' lastRow = Cells(Rows.Count, i).End(xlUp).Row 'copy data from another column' Range(Cells(1, i), Cells(lastRow, i)).Copy 'paste data to column A' Range("A" & lastRowA + 1).PasteSpecial xlPasteValues 'Clear content from another column. if you don't want to clear content from column, remove next line' Range(Cells(1, i), Cells(lastRow, i)).ClearContents Next i Application.CutCopyMode = False End Sub 

Answer 3

试试这个macros

 Sub combine_columns() Dim userResponce As Range Columns(1).Insert ' insert new column at begining of worksheet lrowEnd = 1 'set for first paste to be cell A1 'get user selection of data to combine Set userResponce = Application.InputBox("select a range with the mouse", Default:=Selection.Address, Type:=8) 'this IfElse can be removed once macro is tested. If userResponce Is Nothing Then MsgBox "Cancel clicked" Else MsgBox "You selected " & userResponce.Address End If Set a = userResponce 'this loops through the columns selected and pastes to column A in a stacked foormat For Each b In a.Columns Rng = "A" & lrowEnd Range(b.Address).Copy Range(Rng).PasteSpecial lrowEnd = Cells(Rows.Count, "A").End(xlUp).Row + 1 'find next blank row Next End Sub