worksheet looping

[bobtaske]

Hi I'm relatively new to VBA and programing and I'm trying to to go through the first 31 work sheets search for the term "Power On" in column C and when it find a match copy the entire row and paste it into Sheet33. some sheets might have alot of power on and some might have none. it was working at one point for just a single sheet but now i cant get it to work after modifying it for the first 31 sheets
any help would be greatly appreciated!

Sub test()

   Dim LSearchRow As Long
   Dim LCopyToRow As Long
   Dim ws1 As Worksheet
   Dim I As Integer
   Dim wsCount As Long
   wsCount = ThisWorkbook.Worksheets.Count
   'there will always be 2 extra sheets i dont wish to run this code on
   wsCount = wsCount - 2
      
   LCopyToRow = 1

         
    For I = 1 To wsCount
       Set ws1 = ActiveSheet
   
   LSearchRow = 1


   While Len(Range("A" & CStr(LSearchRow)).Value) > 0

      'If value in column C = "Power On", copy entire row to Sheet33
      If Range("C" & CStr(LSearchRow)).Value = "Power On" Then

         'Select row in ws1 to copy
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy

         'Paste row into Sheet33 in next row
         Sheets("Sheet33").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste

         LCopyToRow = LCopyToRow + 1

         'Go back to ws1
         Sheets(ws1).Select

      End If

      LSearchRow = LSearchRow + 1
      
   Wend

   Exit Sub
    
    Next I

End Sub

 

[footoo]

Untested :

Sub test()

Dim LSearchRow As Long
Dim LCopyToRow As Long
Dim I As Integer
Dim wsCount As Long

wsCount = ThisWorkbook.Worksheets.Count
'there will always be 2 extra sheets i dont wish to run this code on
wsCount = wsCount - 2

LCopyToRow = 1

Application.ScreenUpdating = False

For I = 1 To wsCount
    Worksheets(I).Activate

    LSearchRow = 1

    While Len(Range("A" & CStr(LSearchRow)).Value) > 0

        'If value in column C = "Power On", copy entire row to Sheet33
        If Range("C" & CStr(LSearchRow)).Value = "Power On" Then

            'Select row in ws1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy
            Selection.Copy

            'Paste row into Sheet33 in next row
            Sheets("Sheet33").Select
            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste

            LCopyToRow = LCopyToRow + 1

        End If

        LSearchRow = LSearchRow + 1

    Wend

Next I

'Go back to first sheet
Sheets(1).Select

End Sub

 

[bobtaske]

Untested :

Sub test()

Dim LSearchRow As Long
Dim LCopyToRow As Long
Dim I As Integer
Dim wsCount As Long

wsCount = ThisWorkbook.Worksheets.Count
'there will always be 2 extra sheets i dont wish to run this code on
wsCount = wsCount - 2

LCopyToRow = 1

Application.ScreenUpdating = False

For I = 1 To wsCount
    Worksheets(I).Activate

    LSearchRow = 1

    While Len(Range("A" & CStr(LSearchRow)).Value) > 0

        'If value in column C = "Power On", copy entire row to Sheet33
        If Range("C" & CStr(LSearchRow)).Value = "Power On" Then

            'Select row in ws1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy
            Selection.Copy

            'Paste row into Sheet33 in next row
            Sheets("Sheet33").Select
            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste

            LCopyToRow = LCopyToRow + 1

        End If

        LSearchRow = LSearchRow + 1

    Wend

Next I

'Go back to first sheet
Sheets(1).Select

End Sub

i just tried it, no errors but nothing got put into sheet33, also im not sure if it matters but none of my sheets are named sheet# except sheet33, i tried renaming the first one to Sheet1 but nothing happened then either

 

[footoo]

Try the one below.
If it doesn't work, try stepping through via F8 to see where it is not doing what it is supposed to do.

Sub test()

Dim LSearchRow As Long
Dim LCopyToRow As Long
Dim I As Integer
Dim wsCount As Long

wsCount = ThisWorkbook.Worksheets.Count
'there will always be 2 extra sheets i dont wish to run this code on
wsCount = wsCount - 2

LCopyToRow = 1

Application.ScreenUpdating = False

For I = 1 To wsCount
    Worksheets(I).Activate

    LSearchRow = 1

    While Len(Range("A" & LSearchRow).Value) > 0

        'If value in column C = "Power On", copy entire row to Sheet33
        If Range("C" & LSearchRow).Value = "Power On" Then

            'Copy row in ws paste row into Sheet33 in next row
            Rows(LSearchRow).Copy Sheets("Sheet33").Rows(LCopyToRow)

            LCopyToRow = LCopyToRow + 1

        End If

        LSearchRow = LSearchRow + 1

    Wend

Next I

'Go back to first sheet
Sheets(1).Select

End Sub

 

[bobtaske]

Try the one below.
If it doesn't work, try stepping through via F8 to see where it is not doing what it is supposed to do.

Sub test()

Dim LSearchRow As Long
Dim LCopyToRow As Long
Dim I As Integer
Dim wsCount As Long

wsCount = ThisWorkbook.Worksheets.Count
'there will always be 2 extra sheets i dont wish to run this code on
wsCount = wsCount - 2

LCopyToRow = 1

Application.ScreenUpdating = False

For I = 1 To wsCount
    Worksheets(I).Activate

    LSearchRow = 1

    While Len(Range("A" & LSearchRow).Value) > 0

        'If value in column C = "Power On", copy entire row to Sheet33
        If Range("C" & LSearchRow).Value = "Power On" Then

            'Copy row in ws paste row into Sheet33 in next row
            Rows(LSearchRow).Copy Sheets("Sheet33").Rows(LCopyToRow)

            LCopyToRow = LCopyToRow + 1

        End If

        LSearchRow = LSearchRow + 1

    Wend

Next I

'Go back to first sheet
Sheets(1).Select

End Sub

i just tried this code. it dosnt get hung up or anything it just runs really fast and then ends, it should take at least a min or two to search the entire workbook, 31 pages of 500,000 lines. it just executes in about half a second. when i press f8 it just hilights the first line "sub test" yellow

 

[footoo]

Step through the code by pressing F8 for each line of code.

Make sure this line of code (Worksheets(I).Activate) is sheet(capital I) and not sheet(1).

Also, are there any data in column A starting at A1?

 

[bobtaske]

Step through the code by pressing F8 for each line of code.

Make sure this line of code (Worksheets(I).Activate) is sheet(capital I) and not sheet(1).

Also, are there any data in column A starting at A1?

when i did f8 it only highlighted sub() i made sure its I and not 1

no data is in Sheet 33 at all, A B C are all populated in the rest

 

[footoo]

The macro is working for me.

To step thru the code, press F8 and it will take you to Sub test().
Press F8 again and the arrow goes to the next line. Press again and it will execute that line and go to the next line.
And so on .....
Have a look here : Debugging in Excel VBA