Sub CopyFilteredRow()
Dim SrcWs As Worksheet, NewSh As Worksheet
Dim RngFilter As Range
Dim SrcLR As Long
With Application
.ScreenUpdating = False
.DisplayStatusBar = True
.StatusBar = "!!! Please Be Patient...Updating Records !!!"
.EnableEvents = False
.Calculation = xlManual
End With
Set SrcWs = ActiveSheet
SrcLR = SrcWs.Range("A" & Rows.Count).End(xlUp).Row
Set RngFilter = SrcWs.Range("A1:K" & SrcLR)
With RngFilter
.AutoFilter Field:=8, Criteria1:="<>*Project*"
.SpecialCells(xlCellTypeVisible).Copy
Worksheet.Add After:=SrcWs
ActiveSheet.Paste
End With
ActiveSheet.Name = "FilteredSheet"
Set NewSh = Worksheets("FilteredSheet")
Application.CutCopyMode = False
If SrcWs.AutoFilterMode = True Then SrcWs.AutoFilterMode = False
NewSh.Activate
NewSh.Range("A1").Select
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.StatusBar = False
.EnableEvents = True
.Calculation = xlAutomatic
End With
End Sub
Sub CopyFilteredRow()
Dim SrcWs As Worksheet, NewSh As Worksheet
Dim RngFilter As Range
Dim SrcLR As Long
With Application
.ScreenUpdating = False
.DisplayStatusBar = True
.StatusBar = "!!! Please Be Patient...Updating Records !!!"
.EnableEvents = False
.Calculation = xlManual
End With
Set SrcWs = ActiveSheet
SrcLR = SrcWs.Range("A" & Rows.Count).End(xlUp).Row
Set RngFilter = SrcWs.Range("A1:K" & SrcLR)
With RngFilter
.AutoFilter Field:=8, Criteria1:="<>*Project*"
.SpecialCells(xlCellTypeVisible).Copy
Worksheets.Add.Paste
End With
ActiveSheet.Name = "FilteredSheet"
Set NewSh = Worksheets("FilteredSheet")
Application.CutCopyMode = False
If SrcWs.AutoFilterMode = True Then SrcWs.AutoFilterMode = False
NewSh.Activate
NewSh.Range("A1").Select
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.StatusBar = False
.EnableEvents = True
.Calculation = xlAutomatic
End With
End Sub