Copying entire rows from multiple sheets based on criteria

[safari360]

Hello all, this is my first post. Sorry if I violate any norms or post a question previously answered.
I have multiple worksheets in a workbook that contains tenant information for apartment buildings. On those worksheets, I note a status for each tenant (occupied, vacant, or notice). I would like to have all vacant or units on notice automatically populate on another worksheet in the same workbook where vacancies are compiled. Is there an easy way to do this? I am pretty good with excel but I do not know much about VBA. Thank you for any help you can provide.

 

[vcoolio]

Hello Safari360,

Could you please upload a sample of your workbook to a file sharing site (e.g. Drop Box or GE.TT) then post the link to your sample file back here. This will give potential helpers something to work with/test. Please carefully explain inputs and expected outputs.
Make sure that the sample is an exact replica of your actual workbook and if your data is sensitive, then please use dummy data. A few rows of data will suffice.

Thanks Safari.

Cheerio,
vcoolio.

 

[My Aswer Is This]

I looked at this posting earlier. I would like to see specific details.

Like I have a sheet named "Bob" and in Column B if Yes is in that column copy this row to a sheet named People.

I never open files that may be uploaded to a sharing site.

 

[jolivanes]

Code assumes that you have three Sheets called Occupied, Vacant and Notice. Spelling needs to be exact.
All Sheets have top Row as Header Row.
You have 5 Columns with Data in the tenant information Sheets.
Occupied, Vacant or Notice is in Column D in the tenant information sheets. If some cells in Column D are empty, we need error checking added to the code.
Change all references where and if required.
Code will clear the Occupied, Vacant and Notice Sheets every time it is run.
Try on a copy of your original first.

Sub Maybe()
Dim shArr, i As Long, sht As Worksheet, ii As Long
shArr = Array("Occupied", "Vacant", "Notice")
Application.ScreenUpdating = False

    For i = LBound(shArr) To UBound(shArr)
        Sheets(shArr(i)).UsedRange.Offset(1).ClearContents
    Next i
    
    For Each sht In ActiveWorkbook.Worksheets
        If sht.Name <> shArr(0) And sht.Name <> shArr(1) And sht.Name <> shArr(2) Then
            For ii = 2 To sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
                sht.Cells(ii, 1).Resize(, 5).Copy Sheets(sht.Cells(ii, 4).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1)
            Next ii
        End If
    Next sht
    
Application.ScreenUpdating = True
End Sub