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

Question

I have an Excel 2010 sheet with 300 or so columns. I need all of the data to be pasted into one column (not merged). Is there any way to do this other than copying one column, scrolling to the bottom on the first, pasting, and repeating for every column?

Answer 1

Try this (you may need to change ; to , ):

Answer 2

You can use following code. It will paste all values to the column 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

Try this macro

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