Stack Multiple columns into one on Master sheet

Fel123

New Member
Joined
Aug 27, 2018
Messages
3
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!!


Code:
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
 
Last edited by a moderator:

tonyyy

Well-known Member
Joined
Jun 24, 2015
Messages
1,647
Fel123,

Welcome to the Board.

You might consider the following...

Code:
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

New Member
Joined
Aug 27, 2018
Messages
3
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

Well-known Member
Joined
Jun 24, 2015
Messages
1,647
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...

Code:
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

Well-known Member
Joined
Jun 24, 2015
Messages
1,647
The following eliminates one step from the code in post #4 ...

Code:
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

New Member
Joined
Aug 27, 2018
Messages
3
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

Well-known Member
Joined
Jun 24, 2015
Messages
1,647
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.
 
Last edited:

Forum statistics

Threads
1,082,290
Messages
5,364,320
Members
400,789
Latest member
Gnar

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top