Hi ,
I want to be able to run the code below from any sheet and also with a
macro button.
I want to place the macro button on the first sheet [financial
summary]. but the macro filter would be activated on a different sheet
[production_schedule}
Sub CopyFilter()
Application.ScreenUpdating = False
Dim rng As Range
Dim rng2 As Range
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("F3").AutoFilter
End If
ActiveSheet.Range("$A$4:$IK$3277").AutoFilter Field:=6, Criteria1:= _
"HR & Payroll"
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Worksheets("HR&PAYROLL").Cells.Clear
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("HR&PAYROLL").Range("A5")
End If
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode =
False
Rows("1:4").Select
Selection.Copy
Sheets("HR&PAYROLL").Select
Rows("1:1").Select
ActiveSheet.Paste
Cells.Select
Application.CutCopyMode = False
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("2:2").Select
Selection.Copy
Sheets("HR&PAYROLL").Select
Rows("2:2").Select
ActiveSheet.Paste
Range("A2:J2").Select
With Selection.Font
.FontStyle = "Bold"
.Size = 10
End With
Application.CutCopyMode = False
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Sheets("HR&PAYROLL").Select
Cells.Select
Selection.Columns.AutoFit
Selection.Rows.AutoFit
Rows("2:2").Select
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Application.ScreenUpdating = True
End Sub
Thanks
|
Similar Threads
