How to Copy filtered subtotal to another sheet|VBA & Macros|Excel Forum|My Online Training Hub

Hi JESSICA

Thank you ever so much for the clip. However, I don't wants to extract any list. For this I could use index match but what I want is range of data from V4:AG4 which changes as I change the filter and I want both values to be copied over to another sheet. For eg: If i apply grey color filter values changes at range V4:AG4 and if I change filter to dark grey the values at above range changes again and I want both values copy paste to another sheet.

Any advise! Solution!

Thank you

Hi Anders

Thank you ever so much it worked however, it works when both workbooks are open.

Is there a way to tidy up the code below and make the macro work file another workbook is closed.

Sub Transfertoanotherworkbook()
'
' Transfertoanotherworkbook Macro
'

'
ActiveSheet.Range("$B$8:$CG$1570").AutoFilter Field:=1, Criteria1:=RGB(211 _
, 245, 248), Operator:=xlFilterCellColor
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
Range("X4:AI4").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-51
Windows("AMP7 Capex Aug 2021 WD4.xlsx").Activate
End Sub
Sub Amit()
'
' Amit Macro
'

'
ActiveSheet.Range("$B$8:$CG$1570").AutoFilter Field:=1, Criteria1:=RGB(211 _
, 245, 248), Operator:=xlFilterCellColor
Range("X4:AI4").Select
Selection.Copy
Windows("Major Projects MPR DATA FOR SLIDES aug.xlsb.xlsx").Activate
Range("D39").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("AMP7 Capex Aug 2021 WD4.xlsx").Activate
ActiveSheet.Range("$B$8:$CG$1570").AutoFilter Field:=1, Criteria1:=RGB(128 _
, 128, 128), Operator:=xlFilterCellColor
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
Range("X4:AI4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Major Projects MPR DATA FOR SLIDES aug.xlsb.xlsx").Activate
Range("D19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 35
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 46
Windows("AMP7 Capex Aug 2021 WD4.xlsx").Activate
End Sub