Cleaning multiple sheets of data for creating one sheet to be used as pivot source

Hello Experts,

Every month I get a workbook with multiple sheets in raw format which requires a lot of time clean and get it in one sheet to be used as pivot table data source.
With the help of some experts I have tried to build a code which will

1. Unmerge all the merged cells in all the work sheets (Coz some cells in all the sheets are merged)
2. Find all the worksheets name containing SMRY or SUMMARY and delete
3. In column A of all the remaining worksheets find string AAA & delete all the rows including AAA and above
4. In column A of all the remaining worksheets find string BBB & delete all the rows including BBB and below

But the code below is giving me runtime error.

Besides above I would also like to add a column where it adds the sheet name in each row.

Please advise/help.

Best Regards/VKS

Sub TestII()

Dim Ws As Worksheet
Dim MyRange As Range
Set MyRange = activesheet.Range("A:A")

' Unmerge cells in all worksheets first


For Each Ws In worksheets
Ws.Cells.UnMerge
Next



' IF worksheet name contains SMRY or Summary then delete

    
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

For Each Ws In ActiveWorkbook.worksheets

    If Ws.Name Like "*SMRY*" Then Ws.Delete
    
Next Ws

For Each Ws In ActiveWorkbook.worksheets
    If Ws.Name Like "SUMMARY" Then Ws.Delete
    
Next Ws


Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

For Each Ws In ActiveWorkbook.worksheets


MyRange.Find("AAA", LookIn:=xlValues).Select
    
'    ActiveCell.Offset(-1, 0).Select
    Range(ActiveCell.Row & ":" & 1).Rows.Delete
    
      Next Ws
 For Each Ws In ActiveWorkbook.worksheets
   
    MyRange.Find("BBB", LookIn:=xlValues).Select
    Range(ActiveCell.Row & ":" & 1048576).Rows.Delete
    
    Next Ws
    
End Sub

first:

remove

Set MyRange = activesheet.Range("A:A")

from the beginning of sub

then rewritted code for cleaning above AAA and below BBB could look like:

For Each Ws In ActiveWorkbook.worksheets
' i am not sure if here you do not need 
' Ws.activate  
' if code stops here - remove the comment above
set MyRange = Ws.Range("A:A").Find("AAA", LookIn:=xlValues)
if not Myrange is nothing then
   Rows("1:" & myrange.row).Delete
end if
set MyRange = Ws.Range("A:A").Find("BBB", LookIn:=xlValues)
if not Myrange is nothing then
   Rows(myrange.row & ":" & ws.rows.count).Delete
end if
' here add a column
'like
Columns(1).insert
range("A1")="My header"
Range("A2:A" & myrange.row ).value = ws.name
next ws

PS. If the code stops with error always let us know the error message and in which line it stops. Posting a (sample - no delicate data and not too big one) workbook is always a good idea.

let me autoquote myself:
"Posting a (sample - no delicate data and not too big one) workbook is always a good idea."
Otherwise I have no chance to check what happens (May be you have AAA or BBB more than once in a sheet or BBB above AAA or ... or ??? anything)

Of course you can debug it yourself. In editor do step-in (F8) and observe values in Locals window (or setup some watches) and changes your workbook.

obviously a typo. myramge makes no sense :-) change to myrange

Rows("1:" & myrange.Row).Delete

as there was no sample file attached (see forum rules) - all corrections were just written in forum editor and not tested :-)