Finding data between two texts in same column and then copy all the rows

Dear Experts ,

I am looking for help on a code that will do the following:

First Insert column A in the worksheet and copy sheetname in the column A
then
Find the row number of text AAA in column B
Find the row number of text BBB in column B

Copy all the rows in between (Excluding row of AAA and BBB) and paste it in a new sheet called summary sheet and do it for all the sheets in the workbook
Best Regards/VKS

Sub Summary()
    
    Dim ws As Worksheet, wsSummary As Worksheet
    Dim strFind1 As String, strFind2 As String
    Dim Match1 As Variant, Match2 As Variant
    
    strFind1 = "AAA"
    strFind2 = "BBB"
    
    Application.ScreenUpdating = False
    
    Set wsSummary = Worksheets.Add(After:=Sheets(Sheets.Count))
    On Error Resume Next
        wsSummary.Name = "Summary"
    On Error GoTo 0
    
    For Each ws In Worksheets
        If Not ws Is wsSummary Then
            
            With ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp))
                
                Match1 = Application.Match(strFind1, .Cells, 0)
                Match2 = Application.Match(strFind2, .Cells, 0)
                
                If Not IsError(Match1) And Not IsError(Match2) Then
                    ws.Columns(1).Insert
                    .Offset(, -1).Value = ws.Name
                    ws.Rows(Match1 + 1 & ":" & Match2 - 1).Copy _
                        Destination:=wsSummary.Range("A" & Rows.Count).End(xlUp).Offset(1)
                End If
                
            End With
        End If
    Next ws
    
    Application.ScreenUpdating = True
    
End Sub

Thanks for the your time and help
I got a new summary sheet at the end but sheet is blank and the changes i made are
From the rows below

strFind1 = "AAA"
    strFind2 = "BBB"

to Rows below

strFind1 = "Point to Point(P2P)/Flow Analysis"
    strFind2 = "RPK & ASK"

Best Regards/VKS

It's looking for whole matches and it is not case sensitive.

If you searched for say "My Text"...
Matched:
"MY TEXT"
"my text"

No Match:
"MyText"
"This is My Text"
" My Text"
"My Text "

Surround the text with asterisks for a contains-type match e.g.; "*My Text*"
Matched:
"This is My Text"
"my Text"
This is My Text again"

No Match:
"MyText"
"My Text with two spaces in between"


Perhaps you can search for something like...
strFind1 = "*Point to Point*"
strFind2 = "*RPK*"
...if that is exclusive enough, but allows for possible variances in other parts of the strings.

Also, you could only successfully search a sheet one time because it inserts a column. It wouldn't find matches on a second search unless you delete column A with the sheet name

Thanks a lot for your help. I will try and send you the feedback.

Thanks for your time and help. I tried to manage it but couldn’t reach there.
After not being able to do it on my own looked for some more guidance from the forum using the thread below.

HTML Code: 

Best Regards/VKS

Why would you start a new thread?

This inserts the column first then finds the matches in column B. I don't think that's your problem though.

Sub Summary()
    
    Dim ws As Worksheet, wsSummary As Worksheet
    Dim strFind1 As String, strFind2 As String
    Dim Match1 As Variant, Match2 As Variant
    
    strFind1 = "*AAA*"
    strFind2 = "*BBB*"
    
    Application.ScreenUpdating = False
    
    Set wsSummary = Worksheets.Add(After:=Sheets(Sheets.Count))
    On Error Resume Next
        wsSummary.Name = "Summary"
    On Error GoTo 0
    
    For Each ws In Worksheets
        If Not ws Is wsSummary Then
            
            ws.Columns(1).Insert
            
            With ws.Range("B1", ws.Range("B" & Rows.Count).End(xlUp))
            
                .Offset(, -1).Value = ws.Name
                Match1 = Application.Match(strFind1, .Cells, 0)
                Match2 = Application.Match(strFind2, .Cells, 0)
                
                If Not IsError(Match1) And Not IsError(Match2) Then
                    ws.Rows(Match1 + 1 & ":" & Match2 - 1).Copy _
                        Destination:=wsSummary.Range("A" & Rows.Count).End(xlUp).Offset(1)
                End If
                
            End With
        End If
    Next ws
    
    Application.ScreenUpdating = True
    
End Sub

I don't know why it isn't working for you. The only clue you give me is it doesn't work. It's hard to make a diagnosis from just that. Perhaps you should post an example workbook with data and the macro.

Greetings of the day Sir,
Code worked very well for me. Below is the sequence of events:
1. It gave me a msg box saying Excel cannot complete this task with available resources………
2. Upon clicking ok it started working again and then I got a run time error
3. Clicking on debug took me to “ws.columns(1).insert”
4. When I opened the file I saw 42 sheets were updated and 8 left (Workbook has 50 sheets)
5. I split the workbook in two (25 sheets each)
6. Ran the code again and both had the output summary sheet with desired data.
Thanks a lot once again for your help. I have summary of 50 sheets in two sheets which is much easier than picking up info from 50 worksheets.
One last question please(I think I can use the code in other file too).
If I don’t want to insert a column and populate it with the sheet name then what lines should I remove from the code.
My apologies for the new thread. Started that one keeping in mind the time difference and I was excited to get around the problem and got bit impatient.
Best Regards/VKS

Originally Posted by VKS

If I don’t want to insert a column and populate it with the sheet name then what lines should I remove from the code.

You're welcome.

Comment out the two red lines below from the original code. This version of the code looks for matches in column A before the column is inserted.

The second version of the code can't be changed by just removing the lines. It looks for matches after the column insertion. If the column wasn't inserted, it would still look in column B for the match.

Sub Summary()
    
    Dim ws As Worksheet, wsSummary As Worksheet
    Dim strFind1 As String, strFind2 As String
    Dim Match1 As Variant, Match2 As Variant
    
    strFind1 = "AAA"
    strFind2 = "BBB"
    
    Application.ScreenUpdating = False
    
    Set wsSummary = Worksheets.Add(After:=Sheets(Sheets.Count))
    On Error Resume Next
        wsSummary.Name = "Summary"
    On Error GoTo 0
    
    For Each ws In Worksheets
        If Not ws Is wsSummary Then
            
            With ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp))
                
                Match1 = Application.Match(strFind1, .Cells, 0)
                Match2 = Application.Match(strFind2, .Cells, 0)
                
                If Not IsError(Match1) And Not IsError(Match2) Then
                    ws.Columns(1).Insert
                    .Offset(, -1).Value = ws.Name
                    ws.Rows(Match1 + 1 & ":" & Match2 - 1).Copy _
                        Destination:=wsSummary.Range("A" & Rows.Count).End(xlUp).Offset(1)
                End If
                
            End With
        End If
    Next ws
    
    Application.ScreenUpdating = True
    
End Sub