I have a workbook with many sheets with fixed data structure.
I want to:
First: Fill the last empty column with the sheet name on all sheets.
Second: Delete columns B, C, D, E, F (5 columns) on all sheets.
Third: Merge all worksheets used data range to a new sheet named “Master”.
INPUT DATA:
PARTICULARS H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H14 H15
AA 1 2 3 4 5 6 7 8 9 10 11 12 13
BB 14 15 16 17 18 19 20 21 22 23 24 25 26
CC 27 28 29 30 31 32 33 34 35 36 37 38 39
SHEET NAME: |ECSTASY|BEAUTY| etc,
OUTPUT DATA:
PARTICULAR H6 H7 H8 H9 H10 H11 H12 H14 H15
AA 6 7 8 9 10 11 12 13 ECSTASY
BB 19 20 21 22 23 24 25 26 ECSTASY
CC 32 33 34 35 36 37 38 39 ECSTASY
AA 6 7 8 9 10 11 12 13 BEAUTY
BB 19 20 21 22 23 24 25 26 BEAUTY
CC 32 33 34 35 36 37 38 39 BEAUTY
etc.
I developed code. It is giving the following error
Application defined or Object defined error
on the line
ws.Range(ws.Cells(1, 1), ws.Cells(srcLastRow, srcLastCol - 5)).Copy masterWs.Cells(destLastRow, 1)
Sub CombineSheets()
Dim ws As Worksheet
Dim masterWs As Worksheet
Dim srcLastRow As Long, srcLastCol As Long
Dim destLastRow As Long
' Create the "Master" sheet
Set masterWs = ThisWorkbook.Worksheets.Add
masterWs.Name = "Master"
' Iterate through each worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Master" Then
' Fill the last empty column with the sheet name
srcLastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column + 1
ws.Cells(1, srcLastCol).Value = ws.Name
' Delete columns B, C, D, E, and F
ws.Range("B:F").Delete
' Find the last row in the source and destination sheets
srcLastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
destLastRow = masterWs.Cells(masterWs.Rows.Count, 1).End(xlUp).Row + 1
' Copy the data from the source sheet to the "Master" sheet
ws.Range(ws.Cells(1, 1), ws.Cells(srcLastRow, srcLastCol - 5)).Copy masterWs.Cells(destLastRow, 1)
End If
Next ws
' Clean up
Set ws = Nothing
Set masterWs = Nothing
End Sub
Sub CombineSheets()
Const DST_SHEET As String = "Master"
Const DELETE_COLUMNS As String = "B:F"
Const DST_SHEET_COLUMN_TITLE As String = "Sheet"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Application.ScreenUpdating = False
Dim dsh As Object
On Error Resume Next
Set dsh = wb.Sheets(DST_SHEET)
On Error GoTo 0
If Not dsh Is Nothing Then
Application.DisplayAlerts = False ' delete without confirmation
dsh.Delete
Application.DisplayAlerts = True
End If
Dim sws As Worksheet, rCount As Long, cCount As Long
Dim dws As Worksheet, dfCell As Range, IsFirstFound As Boolean
For Each sws In wb.Worksheets
If IsFirstFound Then ' copy all but the 1st worksheet's data only
With sws.UsedRange
rCount = .Rows.Count - 1
If rCount > 0 Then
.Resize(rCount).Offset(1).Copy dfCell
End If
End With
Else ' copy the 1st worksheet (with headers)
sws.Copy After:=wb.Sheets(wb.Sheets.Count) ' or Before:=wb.Sheets(1)
Set dws = wb.Sheets(wb.Sheets.Count) ' or wb.Sheets(1)
dws.Name = DST_SHEET
With dws.UsedRange
rCount = .Rows.Count - 1
cCount = .Columns.Count
With .Cells(1).Offset(, cCount - 1)
.Copy .Offset(, 1)
.Offset(, 1).Value = DST_SHEET_COLUMN_TITLE
End With
End With
Set dfCell = dws.Range("A2")
IsFirstFound = True
End If
If rCount > 0 Then
dfCell.Offset(, cCount).Resize(rCount).Value = sws.Name
Set dfCell = dfCell.Offset(rCount)
End If
Next sws
dws.Columns(DELETE_COLUMNS).Delete xlShiftToLeft
Application.ScreenUpdating = True
MsgBox "Sheets combined into a Master sheet.", vbInformation
End Sub