How to loop through worksheets and returning rows based on column value

[patrick keady]

This feels simple. But not enough coffee I suppose. Cant get it to work.

I have about ten worksheets in a workbook. The first worksheet is where I want ROWS returned to from the other 9 worksheets based on values in the "C" column of each worksheet. The "C" column is a priority column. So in other words, if PRIORITY is 1 then I want those rows returned first from all worksheets, then iterate through and return all PRIORITY 2's all the way down to PRIORITY level 5.

So in the end my first worksheet should be an aggregate of all rows from all ten worksheets, but listed by priority 1 through 5.

Any help would be GREATLY appreciated!! Thanks

[MikeTheBike]

Hi

You don't say where or how you are running the code, but the routine below is written a a code module and is called fron a button on the target sheet

Option Explicit

Sub CopyWithPriority()
    On Error GoTo ErrorHandler
    
    Const PriorityColumn As Integer = 3 'COLUMN C
    Dim TargetSht As Worksheet
    Dim sht As Worksheet
    Dim iLastRow As Long
    Dim i As Long
    Dim iPriority As Integer
    Dim iTargetRow As Long
    
    Set TargetSht = ActiveSheet 'IT IS ASSUMED THAT THE TARGET SHEET IS SELECTED BEFORE CODE IS RUN (FROM A BUTTON ON THE SHEET!!)
    TargetSht.Cells.ClearContents   'MAY NOT BE NECESSAY BUT IT IS FOR TESTING!!
    
    Application.ScreenUpdating = False 'HIDE ACTIVITY
    iTargetRow = 2   'SET START TARGET ROW
    For iPriority = 1 To 6   'CYCLE THROUGH PRIORITY NUMBERS
        For Each sht In ActiveWorkbook.Sheets   'LOOP THROUGHT SHEETS
            If sht.Name <> TargetSht.Name Then   'IGNORE TARGET SHEET
                sht.Select  'SELECT SOURCE SHEET (TO FIND LAST ROW)
                iLastRow = ActiveCell.SpecialCells(xlLastCell).Row   'GET SHEET LAST ROW
                TargetSht.Select   'GO BACK TO TARGET SHEET
                For i = 1 To iLastRow   'CYCLE DOWN ROWS
                    If sht.Cells(i, PriorityColumn) = iPriority Then  'COPY ROW IF CORRECT PRIORITY
                        sht.Rows(i).Copy   'COPY ROW FROM SOURCE
                        Range(Cells(iTargetRow, 1).Address).PasteSpecial xlPasteAll   'PAST IN TARGRET SHEET
                        iTargetRow = iTargetRow + 1   'UPDATE TARGET ROW
                    End If
                Next i
            End If
        Next sht
    Next iPriority
    Application.ScreenUpdating = True
    Exit Sub
    
ErrorHandler:
    Application.ScreenUpdating = True
    MsgBox "An unexpected error has accured,  Number " & Err.Number & vbLf & Err.Description
End Sub

It will not take much moding to run it from somewhere else.

HTH


MTB

[patrick keady]

Thank you SO much

Wow. Thank you for your time and effort, I am just going to run it everytime the workbook opens, not on a button, sorry didnt mention that part. But Thank you so much for helping!!! Great job.