Copy rows from one sheet to another based on cell value

[craigg3]

I need to copy and paste rows from one sheet to another if the cell value in column B = Bills

Starting on sheet ("iState") at B3, if the cell = Bills, then I need it to copy that whole row to sheet("iSummary") starting on row 3

and then I need it to move to B4 and copy and paste f that cell value = Bill...

and continue until it gets to the end of iState sheet which will usually be about 250 records give or take. I played around with some code but wasn't getting anywhere with what I had. Thanks.

 

[azad092]

I just noticed that the sheets in the All Data file have data at the very bottom of the table. You will have to delete that data in each sheet and then try this revised macro:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Oldvalue As String, Newvalue As String, desWS As Worksheet, lastRow As Long, lastRow2 As Long
    With Application
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    If Intersect(Target, Range("G:G,BK:BK,BR:BR")) Is Nothing Then Exit Sub
    On Error GoTo Exitsub
    Select Case Target.Column
        Case Is = 63, 70
            If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
                GoTo Exitsub
            Else
                If Target.Value = "" Then GoTo Exitsub Else
            End If
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
            If Oldvalue = "" Then
                Target.Value = Newvalue
            Else
                If InStr(1, Oldvalue, Newvalue) = 0 Then
                    Target.Value = Oldvalue & ", " & Newvalue
                Else
                    Target.Value = Oldvalue
                End If
            End If
        Case Is = 7
            Set desWS = Workbooks("All Data.xlsm").Sheets(Target.Value)
            lastRow = desWS.Columns("D").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row + 1
            With ActiveSheet
                .Range("A:B,H:K,N:T,AF:AF,AK:AK,AM:AV,AZ:AZ,BB:BJ,BL:BQ").EntireColumn.Hidden = False
                .ListObjects("Table1").Range.AutoFilter Field:=7, Criteria1:=Target.Value
                lastRow2 = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                .Range("A2:BR" & lastRow2).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(lastRow, 1)
                .Range("A:B,H:K,N:T,AF:AF,AK:AK,AM:AV,AZ:AZ,BB:BJ,BL:BQ").EntireColumn.Hidden = True
            End With
    End Select
    Range("A1").AutoFilter
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
Exitsub:
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

hi mumps
good morning an have nice day
you have done great work.....thank you very much
I try this code...I will inform you If I found any error

 

[Mldeuser]

Hello

I took the code and made some changes so I could have information copied based on column T into various other tabs. My issue is for the tabs Base Rent Retail and Chilled Water the first row on the base office rent is also being pasted into the other two tabs. I am not sure what I need to update to stop this from happening.

Thank you


Sub MM1()
Dim LastRow As Long
LastRow = Sheets("2022 Consolidated").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

With Range("A2:Y" & LastRow)
.AutoFilter Field:=20, Criteria1:="Base Rent Office"
.SpecialCells(xlVisible).Copy
Sheets("Base Rent Office").Cells(2, 1).PasteSpecial xlPasteValues
.AutoFilter
End With

With Range("A2:Y" & LastRow)
.AutoFilter Field:=20, Criteria1:="Base Rent Retail"
.SpecialCells(xlVisible).Copy
Sheets("Base Rent Retail").Cells(2, 1).PasteSpecial xlPasteValues
.AutoFilter
End With


With Range("A2:Y" & LastRow)
.AutoFilter Field:=20, Criteria1:="Condenser Water Billback"
.SpecialCells(xlVisible).Copy
Sheets("Chilled Water").Cells(2, 1).PasteSpecial xlPasteValues
.AutoFilter
End With




End Sub

 

[mumps]

Replace:

.SpecialCells(xlVisible).Copy

with

ActiveSheet.AutoFilter.Range.Offset(1).Copy