copy data for meeting condition in multiple times

cds

Board Regular
Joined
Mar 25, 2012
Messages
84
I have following data wherein I want copy data between all "sr" and "extra" to separate sheet . I have following vba which copies data from first meeting of find conditions ie., row after sr and one row before extra, which is perfect. But same worksheet I have more data which succeed with "sr" and proceeds with extra which I am not not able to copy. again, I want add column in the data sheet and for first meeting sr & extra combination I want add "1" in new column and 2 for next and so on Thereafter I want to transpose them as shown in output . I have attached sample data and output image Kindly help me out .
VBA Code:
Sub loop_through_all_worksheetsnnN12()
Sheets("Sheet1").Select
Dim ws As Worksheet
Dim starting_ws As Worksheet
Dim wsResults As Worksheet
Set starting_ws = ActiveSheet 'remember which worksheet is active in the beginning
Application.ScreenUpdating = False
  For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "matches"
                ws.Activate
   With ws
    
           With Range("d" & Columns("c").Find(What:="SRg", LookAt:=xlPart, MatchCase:=False).Row + 1 & _
              ":d" & Columns("c").Find(What:="Extra", LookAt:=xlPart, MatchCase:=False).Row - 1)
      
                   Sheets("Scoresheet").Activate
                   Set wsResults = ActiveSheet

                 .Offset(0).Resize(.Rows.Count).EntireRow.Copy Destination:=wsResults.Range("a" & Rows.Count).End(xlUp).Offset(1, 0)

             End With
End With
    End If

  Next
  Application.ScreenUpdating = True
End Sub
mydata.PNG
 
Last edited by a moderator:

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
I have uploaded condensed data image
 

Attachments

  • mydata1.PNG
    mydata1.PNG
    67.8 KB · Views: 6
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,243
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top