VBA Compilation with worksheet name

PHOTO EMBED

Wed Jul 10 2024 10:13:06 GMT+0000 (Coordinated Universal Time)

Saved by @miskat80

Sub AddSheetNameAndConsolidate()
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim lastRow As Long, newRow As Long
    Dim sourceWsName As String
    Dim rng As Range
    
    ' Create a new worksheet for consolidated data
    Set newWs = ThisWorkbook.Worksheets.Add
    newWs.Name = "Consolidated Data"
    newRow = 2
    
    ' Add headers to the consolidated worksheet
    newWs.Cells(1, 1).Value = "Source Worksheet"
    
    ' Loop through each worksheet in the workbook
    For Each ws In ThisWorkbook.Worksheets
        ' Skip the consolidated worksheet itself
        If ws.Name <> newWs.Name Then
            ' Determine the name of the source worksheet
            sourceWsName = ws.Name
            
            ' Determine the last row in the current worksheet
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            
            ' Insert a new column A with the worksheet name for each row
            ws.Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            ws.Cells(1, 1).Value = "Source Worksheet"
            ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, 1)).Value = sourceWsName
            
            ' Copy data from column A onward to the consolidated worksheet
            Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, ws.UsedRange.Columns.Count + 1))
            rng.Copy newWs.Cells(newRow, 1)
            
            ' Increment the new row pointer for the next worksheet's data
            newRow = newRow + rng.Rows.Count
        End If
    Next ws
    
    ' Autofit columns in the consolidated worksheet
    newWs.Columns.AutoFit
    
    MsgBox "Consolidation completed successfully!", vbInformation
End Sub
content_copyCOPY