VBA Compilation with worksheet name
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
Comments