CODEWITHSUNDEEP
vbaexcelmerge
Trosky6708
Trosky6708

Reputation: 83

Merge Excel columns into one worksheet by using VBA

I have multiple worksheets, they all have the same number of columns but not the same number of rows. I need to copy all rows from column AS, from each worksheet and paste them on top of each other into a new worksheet. The current column AS contains a formula =X2 & " " & AL2 & "" which is not allowing me to copy the actual "text" and giving me a #ref! error.

What I need to happen: Copy column AS from multiple worksheets so the rows just stack on top of one another. That's all, no formulas just the text. I modified the below code, it works but I just get a #ref! error. I'd be grateful if someone could help!

Sub merge()
    Dim P As Integer

    On Error Resume Next

    Sheets(1).Select
    Worksheets.Add
    Sheets(1).Name = "Merged"
    Sheets(3).Activate
    Columns(45).Select
    Selection.Copy Destination:=Sheets(1).Range("A1")

    For P = 2 To Sheets.Count
        Sheets(P).Activate
        Range("A1").Select
        Selection.Columns(45).Select
        Selection.Copy Destination:=Sheets(1).Range("A1000000").End(xlUp)(2)
    Next
End Sub

Sub opensheets()
    Dim openfiles
    Dim x As Integer
    Dim selectversion As String
    selectversion = Worksheets("Settings").Range("C3").Value
    Dim ver As String

    If selectversion = "2003" Then
        ver = "xls"
    Else
        ver = "xlsx"
    End If

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    openfiles = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files (*." & ver & "), *." & ver, MultiSelect:=True, Title:="Open Files")

    If TypeName(openfiles) = "Boolean" Then
        MsgBox "You need to select atleast one file"
        GoTo ExitHandler
    End If

    x = 1
    While x <= UBound(openfiles)
        Workbooks.Open Filename:=openfiles(x)
        Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Upvotes: 1

Views: 1376

Answers (1)

Vasily
Vasily

Reputation: 5782

Try this:

Sub merge()
    Dim Sh As Worksheet, ShM As Worksheet, i&, z&
    Application.ScreenUpdating = 0
    Set Sh = Worksheets.Add(, Sheets(Sheets.Count))
    Sh.Name = "consolidated"
    For Each ShM In ThisWorkbook.Worksheets
        If ShM.Name <> Sh.Name Then
            i = ShM.Cells(Rows.Count, 45).End(xlUp).Row
            z = Sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
            ShM.Activate: ShM.Range(Cells(1, 45), Cells(i, 45)).Copy
            Sh.Activate: Sh.Cells(z, 1).PasteSpecial xlPasteValues
        End If
    Next ShM
    Application.ScreenUpdating = 1
End Sub

Upvotes: 1

Related Questions