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.Columns.AutoFit
NewSh.Range("A2").Select
ActiveWindow.FreezePanes = True
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.StatusBar = False
.EnableEvents = True
.Calculation = xlAutomatic
End With
End Sub
ASKER
Microsoft Excel topics include formulas, formatting, VBA macros and user-defined functions, and everything else related to the spreadsheet user interface, including error messages.
TRUSTED BY
ASKER