Stack Multiple columns into one on Master sheet

[Fel123]

Hi Everyone,


I would like to create a vba that helps

1) Create a master sheet
2) Loop through all worksheets starting with " Data"
3) Copy column DH onwards to last column and stack them in one column on Master sheet , pasting them as values
4) If master sheet exists, to just replace data ( don't need to create again)



So far this is my code, but it only copies out column DH from each sheet, how do i extend it to other columns as well ? How can I also add point 4) to this?
Thank you in advance!!

Sub ColumnAMaster()
Dim lastRow As Long, lastRowMaster As Long
Dim ws As Worksheet
Dim Master As Worksheet
Application.ScreenUpdating = False
Set Master = Sheets.Add
Master.Name = "Master"
lastRowMaster = 1

For Each ws In ThisWorkbook.Sheets
    If Left(Trim(ws.Name), 4) = "Data" Then
        lastRow = ws.Range("DH" & Rows.count).End(xlUp).Row
        lastRowMaster = Master.Range("A" & Rows.count).End(xlUp).Row + 1
        ws.Range("DH11:DH" & lastRow).Copy
        Sheets("Master").Range("A" & lastRowMaster).PasteSpecial xlPasteValues
        
    End If
Next
Application.ScreenUpdating = True
MsgBox "Done!"

End Sub

 

[tonyyy]

Fel123,

Welcome to the Board.

You might consider the following...

Sub ColumnAMaster()
Dim lastRow As Long, lastRowMaster As Long, i As Long, j As Long
Dim ws As Worksheet, Master As Worksheet
Dim exists As Boolean
Dim Col As Range
Application.ScreenUpdating = False

exists = False
For i = 1 To Sheets.Count
    If Sheets(i).Name = "Master" Then
        Set Master = Sheets("Master")
        exists = True
        Exit For
    End If
Next i

If Not exists Then Sheets.Add.Name = "Master"
lastRowMaster = 1

For Each ws In ThisWorkbook.Sheets
    If Left(Trim(ws.Name), 4) = "Data" Then
        For j = 112 To ws.UsedRange.Columns.Count
            lastRow = ws.Range(Columns(j) & Rows.Count).End(xlUp).Row
            lastRowMaster = Master.Range("A" & Rows.Count).End(xlUp).Row + 1
            ws.Range(Cells(11, Columns(j)), Cells(lastRow, Columns(j))).Copy
            Sheets("Master").Range("A" & lastRowMaster).PasteSpecial xlPasteValues
        Next j
    End If
Next ws
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

Please note the code is untested.

Cheers,

tonyyy

 

[Fel123]

Hi Tonyyy,

Thanks for your help, really appreciate it!

There was a Run-time error '13': Type mismatch error when I tried running the code.
When debugging, it pointed to this row:

lastRow = ws.Range(Columns(j) & Rows.count).End(xlUp).Row

Is it because it was not able to read columns (j) as for e.g. "DH"?

Cheers,
Felicia

 

[tonyyy]

Hi Felicia,

Is it because it was not able to read columns (j) as for e.g. "DH"?

Yes, you're correct... ws.Range is looking for a letter (eg, DH, DI, etc) and not a number. Please try the following...

Sub ColumnAMaster()
Dim lastrow As Long, lastRowMaster As Long, i As Long, j As Long
Dim ws As Worksheet, Master As Worksheet
Dim exists As Boolean
Dim arr As Variant
Dim Col As String
Application.ScreenUpdating = False

exists = False
For i = 1 To Sheets.Count
    If Sheets(i).Name = "Master" Then
        exists = True
        Exit For
    End If
Next i

If Not exists Then Sheets.Add.Name = "Master"
Set Master = Sheets("Master")
lastRowMaster = 1

For Each ws In ThisWorkbook.Sheets
    If Left(Trim(ws.Name), 4) = "Data" Then
        For j = 112 To ws.UsedRange.Columns.Count
            arr = Split(Cells(1, j).Address(True, False), "$")
            Col = arr(0)
            lastrow = ws.Range(Col & Rows.Count).End(xlUp).Row
            lastRowMaster = Master.Range("A" & Rows.Count).End(xlUp).Row + 1
            ws.Range(ws.Cells(11, Col), ws.Cells(lastrow, Col)).Copy
            Sheets("Master").Range("A" & lastRowMaster).PasteSpecial xlPasteValues
        Next j
    End If
Next ws
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

 

[tonyyy]

The following eliminates one step from the code in post #4 ...

Sub ColumnAMaster()
Dim lastrow As Long, lastRowMaster As Long, i As Long, j As Long
Dim ws As Worksheet, Master As Worksheet
Dim exists As Boolean
Dim Col As String
Application.ScreenUpdating = False

exists = False
For i = 1 To Sheets.Count
    If Sheets(i).Name = "Master" Then
        exists = True
        Exit For
    End If
Next i

If Not exists Then Sheets.Add.Name = "Master"
Set Master = Sheets("Master")
lastRowMaster = 1

For Each ws In ThisWorkbook.Sheets
    If Left(Trim(ws.Name), 4) = "Data" Then
        For j = 112 To ws.UsedRange.Columns.Count
            Col = Split(Cells(1, j).Address(True, False), "$")(0)
            lastrow = ws.Range(Col & Rows.Count).End(xlUp).Row
            lastRowMaster = Master.Range("A" & Rows.Count).End(xlUp).Row + 1
            ws.Range(ws.Cells(11, Col), ws.Cells(lastrow, Col)).Copy
            Sheets("Master").Range("A" & lastRowMaster).PasteSpecial xlPasteValues
        Next j
    End If
Next ws
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

 

[Fel123]

Hi Tonyyy,

Thank you, the code worked exactly as needed!!
Just curious though , I am trying to understand how this line eventually achieved the letters ( e.g. DH, DI) ...what does this portion of the code (in purple) mean?
Col = Split(Cells(1, j).Address(True, False), "$")(0)

 

[tonyyy]

So, assuming j = 112, you know that Cells(1, j).Address will return $DH$1. The $ symbol indicates that both the Column (ie, DH) and Row (ie, 1) are absolute/constant.

Cells(1, j).Address(True, False) is shorthand for Cells(1, j).Address(RowAbsolute:=True, ColumnAbsolute:=False). With ColumnAbsolute set to False, this portion of the code returns DH$1.

The Split function uses the $ symbol as the delimiter and creates the array (DH, 1). And the first item (0) is DH.

Note: Instead of the words (True, False) you could write this even shorter as (1,0)... Cells(1, j).Address(1, 0)

Thank you, the code worked exactly as needed!!

You're very welcome.