Fine tuning code

[dpaton05]

I have some code I have written

Sub Transfer()
        Dim ws As Worksheet, sh As Worksheet, sht As Worksheet
        Set sh = Sheets("Totals")
        Set sht = Sheets("Cancellations")
        Dim Req As String: Req = sh.[B25].Value
        Dim Dt As String: Dt = sh.[B27].Value
        
Application.ScreenUpdating = False
        
        For Each ws In Worksheets
                If ws.Name <> "Cancellations" And ws.Name <> "Totals" And ws.Name <> "Sheet2" Then
                        With ws.[A3].CurrentRegion
                                .AutoFilter 1, Dt           ' autofilter for the value in cell [B27]
                                .AutoFilter 3, Req          ' autofilter for the value in cell [B25]
                                .Offset(1).EntireRow.Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1)
                                .Offset(1).EntireRow.Delete
                                .AutoFilter                 ' turn off the autofilter
                        End With
                End If
        Next ws
        
sh.Range("B25,B27").ClearContents
Application.ScreenUpdating = True

End Sub

The code works fine but I want to fine tune it.

There are sheets for every month as well as the 3 sheets mentioned in the code. The monthly sheets and the cancellations sheet have the same format. There will be only 1 row that have Dt and Req in the document and I want to move that row to the cancellations sheet.

At the moment, it loops through all monthly sheets, runs the autofilter, copies the last row (blank or not) to sht then deletes the row just below the header then moves to the next sheet.

What I want to do with it is search through each worksheet, looking for the row that contains Dt and Req. When it is found, move the row, delete the row where it was, then exit the loop.



Can someone help me with this please?

 

[dpaton05]

Nevermind, I worked it out.

 

[tico_ocit]

I worked on a code in order to help you getting faster.
I preferer for next instead of for each, you know why?
Because you can settle on which sheet you want to start. Imagine you already did what you want in some months and want just a few, you can change the value of i to start wherever you want.
Another thing is the variant array, is super fast.
If you want the suggestion use it.

Sub for_sheet()

 Dim WS_Count As Integer
Dim i As Integer
Dim varray As Variant
Dim a As Long
Dim lastrow As Integer
Dim Dt As String
Dim Req As String

Dt = "ok"
Req = "yes"
         ' Set WS_Count equal to the number of worksheets in the active workbook

         WS_Count = ActiveWorkbook.Worksheets.count

         ' Begin the loop. I USED I=4 TO AVOID THE SHEETS THAT YOU MENTION. BUT BE AWARE OF THEIR POSITION.
         For i = 4 To WS_Count
         ActiveWorkbook.Worksheets(i).Activate
         lastrow = Cells(Rows.count, "A").End(xlUp).Row
         varray = ActiveSheet.Range("A1:A" & lastrow).Value
            For a = 1 To UBound(varray, 1)
                  
                  If varray(a, 1) = Dt Then
                   lastrow_cancel = Sheets("Cancellations").Cells(Rows.count, "A").End(xlUp).Row
                  ActiveSheet.Range(a & ":" & a).EntireRow.Copy Sheets("Cancellations").Range("A" & lastrow_cancel + 1)
                  ActiveSheet.Range(a & ":" & a).EntireRow.Delete
                  varray = ActiveSheet.Range("A1:A" & lastrow).Value
                  ElseIf varray(a, 1) = Req Then
                  lastrow_cancel = Sheets("Cancellations").Cells(Rows.count, "A").End(xlUp).Row
                  ActiveSheet.Range(a & ":" & a).EntireRow.Copy Sheets("Cancellations").Range("A" & lastrow_cancel + 1)
                  ActiveSheet.Range(a & ":" & a).EntireRow.Delete
                  varray = ActiveSheet.Range("A1:A" & lastrow).Value
                  End If
              Next
            
  
  

         Next i
End Sub