View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Chris Chris is offline
external usenet poster
 
Posts: 788
Default 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