Excel merge all columns with VBA

问题

I'm using MS Excel 2010 and i have an excel sheet without macro's and without formula's everything is in raw format.

The sheet contains a lot of columns and rows (column A to WC) as shown in diagram below.

~ represents split view between columns
# represents row number


          | A | B | C | ~ | AA | AB | ~ | WC |
     -----------------------------------------
    |#   1| x | x | x | ~ |  x |  x | ~ |  x |
    |#  10| x | x | x | ~ |  x |  x | ~ |  x |
    |# 100| x | x | x | ~ |  x |  x | ~ |  x |
    |#1000| x | x | x | ~ |  x |  x | ~ |  x |
    |#2000| x | x | x | ~ |  x |  x | ~ |  x |
    |#3000| x | x | x | ~ |  x |  x | ~ |  x |

I would like to (merge) move all columns from "B" to "WC" into the last row of column "A".

Contents of column "A" may not be discarded. Every column "B" to "WC" has to be inserted below the last row in column "A"

Example (after):

          | A | B | C | ~ | AA | AB | ~ | WC |
     -----------------------------------------
    |#   1| x |   |   | ~ |    |    | ~ |    |
    |#  10| x |   |   | ~ |    |    | ~ |    |
    |# 100| x |   |   | ~ |    |    | ~ |    |
    |#1000| x |   |   | ~ |    |    | ~ |    |
    |#2000| x |   |   | ~ |    |    | ~ |    |
    |#3000| x |   |   | ~ |    |    | ~ |    |
    |#4000| x |   |   | ~ |    |    | ~ |    |
    |#5000| x |   |   | ~ |    |    | ~ |    |
    |#6000| x |   |   | ~ |    |    | ~ |    |
    |#7000| x |   |   | ~ |    |    | ~ |    |
    |#8000| x |   |   | ~ |    |    | ~ |    |
    |#9999| x |   |   | ~ |    |    | ~ |    |

My columns deliberately do not contain column headers (column-names).

What is the best way of achieving this?

I did found this thread: How to merge rows in a column into one cell in excel? -- and honestly i can't really understand how to apply in on my Sheet at this moment. Secondly that topic was created 3 years ago and was active more than 2 months ago. There for i decided to ask a new question here.

I have done research an found a lot of different types of ways of merging:

> Some recommend CONCATENATE-formula 
> Some recommend Transpose formula
> Some recommend macro Some use a VBA script
> Some recommend JOIN function
> Some recommend payed solutions like Kutools

Considering the amount of columns in my situation i think that a VBA script solution would be most appropriate. If someone could please give feedback i would give a +1

Thanks!

Updates:

(its now late here) i'm scripting a new macro from scratch that basically does
1. select column B
2. select until top until last row in column B
3. copy contents
4. select column A
5. navigate to last row in column A
6. go 1 cell down
7. paste contents of column B
8. select column B
9. DELETE column B
10. Repeat 600 times :-)

Update 2:

Here is my self-made macro without for-loop:

    Sub CopyColumnBtoAandDeleteB()
Worksheets("Sheet1").Activate
Range("B1", Range("B1").End(xlDown)).Select
Range("B1", Range("B1").End(xlDown)).Copy
Range("A1").End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteValues
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
End Sub

Oops. for some reason this stops after 305707 records, this was because my sheet contained many active cells, causing additional bank cells in a range and overflowing my rows in column A exceeding the memory limitations of Excel. That's a different issue for another time.

回答1:

This is a sort of Tetris approach. It may not be the quickest but turning off screen updating and event handling should speed it up. Calculation mode may also be an option to set to xlCalculationManual if there are formulas involved.

Sub from_A_to_WC()
    Dim c As Long, grp As Long, cols As Long
    apps_Toggle
    With Sheets("Sheet3")
        grp = .Cells(Rows.Count, 1).End(xlUp).Row
        cols = .Columns("WC").Column
        For c = 2 To cols
            .Cells(1, 2).Resize(grp, cols).Insert Shift:=xlDown
            .Cells((c - 1) * grp, 1).Offset(1, 0).Resize(grp, 1).Delete Shift:=xlToLeft
        Next c
    End With
    apps_Toggle
End Sub

Sub apps_Toggle()
    Application.ScreenUpdating = Not Application.ScreenUpdating
    Application.EnableEvents = Not Application.EnableEvents
End Sub

Change the worksheet name in the third line of you need to and adjust the boundary column (currently column WC) in the 5th if that doesn't match your data.

It really isn't an appropriate solution if you have anything other than the relevant data on the worksheet as it will greatly displace anything that isn't being moved.

回答2:

Here's an approach using arrays to speed things up.

Option Base 1 ' Don't omit this line!
Sub ArrayMan()

    Dim u As Long
    Dim v As Long
    Dim k As Long: k = 1
    Dim z As Long

    InArray = Range("A1:WC400").Value 'Change to your actual dimensions

    u = UBound(InArray, 1)
    v = UBound(InArray, 2)
    z = u * v

    Dim OutArray() As Variant
    ReDim OutArray(z)

    For i = 1 To v 'columns
        For j = 1 To u 'rows
            OutArray(k) = InArray(j, i)
            k = k + 1
        Next
    Next
    Range("A1:A" & z) = WorksheetFunction.Transpose(OutArray)

End Sub

回答3:

This tiny macro code worked for me:

    Sub CopyColumnBtoAandDeleteB()
Worksheets("Sheet1").Activate
Range("B1", Range("B1").End(xlDown)).Select
Range("B1", Range("B1").End(xlDown)).Copy
Range("A1").End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteValues
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
End Sub

Unfortunately this it stops after 305707 records because of limitations of MS Excel 2010, i recommend that if someone else uses it you should get rid of a couple of columns because 255 is a lot of columns (even for MS Access). You should also run MS Excel in Safe mode.

来源：https://stackoverflow.com/questions/28931256/excel-merge-all-columns-with-vba

标签

excel

excel-vba

merge

multiple-columns

vba