Multi Worksheet Criteria based VBA Row Copy Coding

[cleinen1]

I have a worksheet containing itemized inventories of rooms throughout our campus with condition ratings given to each item based upon damage and so on. I'm trying to create a macro to automate the process of scanning all of these worksheets for condition values under a 3. All of my worksheets are formatted the same with the same column headings only different row counts.

My question is this, I am fairly new to VBA coding in excel, How can I have it find values below 3 in a specific column on each worksheet and copy them to a predesignated output worksheet? I have found and modified the following code to match what I'm doing so far, but I don't know how to modify it to continue through the additional sheets as this only applies to one sheet so far?

Sub MoveRowBasedOnCellValue()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Hvidsten Hall of Music - MUS").UsedRange.Rows.count
    J = Worksheets("Low Condition Report").UsedRange.Rows.count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Low Condition Report").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Hvidsten Hall of Music - MUS").Range("Q1:Q" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.count
        If CStr(xRg(K).Value) = "Yes" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Low Condition Report").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[cleinen1]

Quick Edit: I have an if function in the worksheets returning a Yes or No if the item needs to be addressed, I'm trying to copy and paste each row that returns a yes.

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub MergeData()
   Dim Mws As Worksheet
   Dim Ws As Worksheet
   
   Set Mws = Sheets("Low Condition Report")
   For Each Ws In Worksheets
      If Not Ws Is Mws Then
         If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
         Ws.Range("A1:Q1").AutoFilter 17, "yes"
         Ws.AutoFilter.Range.Offset(1).Copy Mws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         Ws.AutoFilterMode = False
      End If
   Next Ws
End Sub

 

[cleinen1]

Not quite working, It's giving me an error that reads "AutoFilter method of Range class failed." What can I do to get past this?

I also forgot to put in the first post that I also need to exclude 3 specific worksheets from this code, which is another major tripping point for me.

 

[Fluff]

Ok, a few questions.
Do you have a header row in row 1 starting in col A?
Do you have any merged cells?
Are any of the sheets protected?
Is your data in a proper table?

 

[cleinen1]

I don't have any merged cells, I do have identical header rows on each sheet in question, I don't have any protected sheets and they are all in proper tables. Not all of the tables have data in them quite yet however as the project is still a work in progress. Only 4 of the 12 sheets that will have data to pull are completed so far.

 

[Fluff]

If you've just got 1 table per sheet try

Sub MergeData()
   Dim Mws As Worksheet
   Dim Ws As Worksheet
   
   Set Mws = Sheets("Low Condition Report")
   For Each Ws In Worksheets
      If Not Ws Is Mws Then
         If Ws.FilterMode Then Ws.ShowAllData
         Ws.ListObjects(1).Range.AutoFilter 10, "yes"
         Ws.AutoFilter.Range.Offset(1).Copy Mws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         Ws.ShowAllData
      End If
   Next Ws
End Sub

 

[cleinen1]

I'm getting a different run-time error now it says "Subscript Out of Range"

 

[cleinen1]

All of my tables are the same size with identical headers. They have drastically different row counts however, could this be the issue?

 

[Fluff]

Which line of code gives the error?
The number of rows isn't a problem, but have noticed that I forgot to change the filter column

Ws.ListObjects(1).Range.AutoFilter [COLOR=#ff0000]17[/COLOR], "yes"