Insert an autofiltered range into another tab
Thank you very much. It's working.
Chris
"OssieMac" wrote:
Hi Chris,
Modified to include the column headers. Does not subtract 1 from the
numbRows and removed the offset and resize from the range to copy.
Sub B_CreateTabs()
Dim rngE As Range
Dim lngLastRow As Long
Dim mgrval, lobval, shtval As String
Dim numbRows As Long
mgrval = "myself"
lobval = "dept"
shtval = mgrval & "-" & lobval
Windows("MyWorkbook.xls").Activate
Sheets(shtval).Select
Sheets(shtval).Copy _
After:=Workbooks("MyWorkbook.xls").Sheets(1)
Sheets("Reports").Select
ActiveSheet.AutoFilterMode = False
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
'Apply the filter
ActiveSheet.Range("A1:G" & lngLastRow) _
.AutoFilter Field:=3, Criteria1:=lobval
ActiveSheet.Range("A1:G" & lngLastRow) _
.AutoFilter Field:=4, Criteria1:=mgrval
'Count number of visible cells in one column.
'Includes column headers
numbRows = Sheets("Reports") _
.AutoFilter.Range.Columns(1) _
.SpecialCells(xlCellTypeVisible) _
.Cells.Count
'Insert the number of required rows starting row 2
'Includes row for column header.
Sheets(shtval).Rows(2 & ":" & 2 + numbRows - 1) _
.Insert Shift:=xlDown
'Copy the visible data including column headers
With Sheets("Reports").AutoFilter.Range
.EntireRow _
.SpecialCells(xlCellTypeVisible) _
.Copy
End With
'Paste the data starting row 2
Sheets(shtval).Rows(2).PasteSpecial
Sheets("Reports").Select
Range("A2").Select
ActiveSheet.AutoFilterMode = False
End Sub
--
Regards,
OssieMac
|