Stack Columns from Multiple Sheets into One Column VBA Code

[odikatmeow]

Hello,

I am trying to write a macro to take column C from 13 separate worksheets and stack them into one large (column A) on a separate worksheet named "merged". Data is added to these columns periodically so the range needed to stack up to the last non empty cell will change.

The 13 sheets are named:
New Contracts-SWFL
New Contracts-SEFL
New Contracts-JL
New Contracts-NY
New Contracts-Col_WI
New Contracts-PBC
New Contracts-CHI
New Contracts-RI
New Contracts-CT
New Contracts-GA
New Contracts-GAL
New Contracts-TPA
New Contracts-MN

I have been trying to piece together code from similar answers on this forum but have been unsuccessful so far.

Any help would be greatly appreciated.

 

[DanteAmor]

Hi and welcome to MrExcel!

The names of the sheets are specified in the array, so that only those sheets are read, in case you have more sheets in the book that you don't want to combine.

Try this:

Sub stack_columns()
  Dim sh As Variant, ary As Variant
  Dim lr As Long
  
  ary = Array("New Contracts-SWFL", "New Contracts-SEFL", "New Contracts-JL", _
              "New Contracts-NY", "New Contracts-Col_WI", "New Contracts-PBC", _
              "New Contracts-CHI", "New Contracts-RI", "New Contracts-CT", _
              "New Contracts-GA", "New Contracts-GAL", "New Contracts-TPA", _
              "New Contracts-MN")
              
  For Each sh In ary
    lr = Sheets(sh).Range("C" & Rows.Count).End(3).Row
    Sheets("merged").Range("A" & Rows.Count).End(3)(2).Resize(lr).Value = Sheets(sh).Range("C1:C" & lr).Value
  Next
End Sub

 

[Trebor76]

Hi odikatmeow,

I see Dante Amor has posted a pretty solution but here's my attempt nonetheless:

Option Explicit
Sub Macro1()

    Dim varItem As Variant
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Dim lngRowFrom As Long, lngRowTo As Long
    
    Application.ScreenUpdating = False
    
    Set wsTo = ThisWorkbook.Sheets("merged") '<-Sheet name to consolidate sheets in following array.
    lngRowFrom = 2 '<-Sharting row number in Col. C from each sheet in the following array to be consolidated. Change to suit.
    
    For Each varItem In Array("New Contracts-SWFL", "New Contracts-SEFL", "New Contracts-JL", "New Contracts-NY", "New Contracts-Col_WI", "New Contracts-PBC", "New Contracts-CHI", _
                              "New Contracts-CHI", "New Contracts-RI", "New Contracts-CT", "New Contracts-GA", "New Contracts-GAL", "New Contracts-TPA", "New Contracts-MN")
        Set wsFrom = ThisWorkbook.Sheets(CStr(varItem))
        lngRowTo = wsTo.Cells(Rows.Count, "A").End(xlUp).Row + 1
        wsFrom.Range("C" & lngRowFrom & ":C" & wsFrom.Range("C" & Rows.Count).End(xlUp).Row).Copy Destination:=wsTo.Range("A" & lngRowTo)
    Next varItem
    
    Application.ScreenUpdating = True
    
End Sub

Regards,

Robert

 

[odikatmeow]

Hi odikatmeow,

I see Dante Amor has posted a pretty solution but here's my attempt nonetheless:

Option Explicit
Sub Macro1()

    Dim varItem As Variant
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Dim lngRowFrom As Long, lngRowTo As Long
   
    Application.ScreenUpdating = False
   
    Set wsTo = ThisWorkbook.Sheets("merged") '<-Sheet name to consolidate sheets in following array.
    lngRowFrom = 2 '<-Sharting row number in Col. C from each sheet in the following array to be consolidated. Change to suit.
   
    For Each varItem In Array("New Contracts-SWFL", "New Contracts-SEFL", "New Contracts-JL", "New Contracts-NY", "New Contracts-Col_WI", "New Contracts-PBC", "New Contracts-CHI", _
                              "New Contracts-CHI", "New Contracts-RI", "New Contracts-CT", "New Contracts-GA", "New Contracts-GAL", "New Contracts-TPA", "New Contracts-MN")
        Set wsFrom = ThisWorkbook.Sheets(CStr(varItem))
        lngRowTo = wsTo.Cells(Rows.Count, "A").End(xlUp).Row + 1
        wsFrom.Range("C" & lngRowFrom & ":C" & wsFrom.Range("C" & Rows.Count).End(xlUp).Row).Copy Destination:=wsTo.Range("A" & lngRowTo)
    Next varItem
   
    Application.ScreenUpdating = True
   
End Sub

Regards,

Robert

Robert,

Thank you very much for your response.

It seems your code is taking column C in worksheet "New Contracts-SWFL" and pasting in column A of worksheet "merged" (which is great) but then I can't get it to stack the data from the rest of the worksheets below it.

Am I missing something? I am very new to this and appreciate any assistance you can provide.

Thank you

 

[odikatmeow]

Hi and welcome to MrExcel!

The names of the sheets are specified in the array, so that only those sheets are read, in case you have more sheets in the book that you don't want to combine.

Try this:

Sub stack_columns()
  Dim sh As Variant, ary As Variant
  Dim lr As Long
 
  ary = Array("New Contracts-SWFL", "New Contracts-SEFL", "New Contracts-JL", _
              "New Contracts-NY", "New Contracts-Col_WI", "New Contracts-PBC", _
              "New Contracts-CHI", "New Contracts-RI", "New Contracts-CT", _
              "New Contracts-GA", "New Contracts-GAL", "New Contracts-TPA", _
              "New Contracts-MN")
             
  For Each sh In ary
    lr = Sheets(sh).Range("C" & Rows.Count).End(3).Row
    Sheets("merged").Range("A" & Rows.Count).End(3)(2).Resize(lr).Value = Sheets(sh).Range("C1:C" & lr).Value
  Next
End Sub

Thank you very much DanteAmore,

It seems your code is taking column C in worksheet "New Contracts-SWFL" and pasting in column A of worksheet "merged" (which is great) but then I can't get it to stack the data from the rest of the worksheets below it.

Am I missing something? I am very new to this and appreciate any assistance you can provide.


Thank you

 

[DanteAmor]

but then I can't get it to stack the data from the rest of the worksheets below it.

But you don't have to. The macro stacks the content of all the sheets, one below the other, checks in the "merged" sheet the content of all the cells in column C, that must be the data, maybe it's too low, so you have to scroll down until you find the data.
And that is because in your sheets you have cells in column C with blank spaces or you have formulas in the cells?

If you have formulas then try this:

Sub stack_columns()
  Dim Sh As Variant, ary As Variant
  Dim lr As Long
  Dim f As Range
  
  ary = Array("New Contracts-SWFL", "New Contracts-SEFL", "New Contracts-JL", _
              "New Contracts-NY", "New Contracts-Col_WI", "New Contracts-PBC", _
              "New Contracts-CHI", "New Contracts-RI", "New Contracts-CT", _
              "New Contracts-GA", "New Contracts-GAL", "New Contracts-TPA", _
              "New Contracts-MN")
              
  For Each Sh In ary
    Set f = Sheets(Sh).Range("C:C").Find("*", , xlValues, xlPart, xlByRows, xlPrevious)
    If Not f Is Nothing Then
      lr = f.Row
      Sheets("merged").Range("A" & Rows.Count).End(3)(2).Resize(lr).Value = Sheets(Sh).Range("C1:C" & lr).Value
    End If
  Next
End Sub