Merge sheets - sheet name with data

bouncey

New Member
Joined
Jan 13, 2010
Messages
34
I have found the code below on this site which U use to consolidate 5 sheets into one. is possible, The text that is red in the code below, can this just be done without the yes no so it just includes the sheet name? Also how could I get this to work every time there is a change

VBA Code:
Option Explicit

Sub ConsolidateSheets()
'Author:    Jerry Beaucaire
'Date:      6/26/2009
'Updated:   6/23/2010
'Merge all sheets in a workbook into one summary sheet (stacked)
'Data is sorted by a specific column name
Dim cs As Worksheet, WS As Worksheet
Dim LR As Long, NR As Long, sCol As Long
Dim sName As Boolean, SortStr As String
Application.ScreenUpdating = False

'From the headers in data sheets, enter the column title to sort by when finished
SortStr = "Invoice #"

'Add consolidation sheet if needed
If Not Evaluate("ISREF(Consolidate!A1)") Then _
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Consolidate"

'Option to add sheet names to consolidation report
[COLOR=rgb(209, 72, 65)]sName = MsgBox("Add sheet names to consolidation report?", vbYesNo + vbQuestion) = vbYes[/COLOR]

'Setup
Set cs = ActiveWorkbook.Sheets("Consolidate")
cs.Cells.ClearContents
NR = 1

'Process each data sheet
    For Each WS In Worksheets
        If WS.Name <> "Consolidate" Then
            LR = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
            'customize this section to copy what you need
            If NR = 1 Then      'copy titles and data to start the consolidation
                WS.Range("A1", WS.Cells(1, Columns.Count).End(xlToLeft)).Copy
                If sName Then
                    cs.Range("B1").PasteSpecial xlPasteAll
                Else
                    cs.Range("A1").PasteSpecial xlPasteAll
                End If
                NR = 2
            End If
            
            WS.Range("A2:BB" & LR).Copy     'copy data

            If sName Then       'paste and add sheet names if required
                cs.Range("B" & NR).PasteSpecial xlPasteValues
                cs.Range("A" & NR, cs.Range("B" & cs.Rows.Count).End(xlUp).Offset(0, -1)) = WS.Name
            Else
                cs.Range("A" & NR).PasteSpecial xlPasteValues
            End If
            
            NR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row + 1
        End If
    Next WS

'Sort
    LR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row
    On Error Resume Next
    sCol = cs.Cells.Find(SortStr, after:=cs.Range("A1"), LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column
    cs.Range("A1:BB" & LR).Sort key1:=cs.Cells(2, sCol + (IIf(sName, 1, 0))), Order1:=xlAscending, _
        Header:=xlYes, ordercustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Cleanup
    If sName Then cs.[A1] = "Sheet"
    cs.Rows(1).Font.Bold = True
    cs.Cells.Columns.AutoFit
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    cs.Activate
    Range("A1").Select
    Set cs = Nothing
End Sub

Thanks in advance
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

Watch MrExcel Video

Forum statistics

Threads
1,129,795
Messages
5,638,370
Members
417,023
Latest member
Zimbo38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top