VBA Help for Applying Same Macro across Worksheets

[excelnoob12345]

Hi all,

I have a code that I would like to apply to multiple worksheets. Basically I am trying to use advanced filter which draws data from Sheets("CopyPaste") and the criteria and output is into all of the different multiple sheets.

This code only works if I click on each sheet to activate it and run the Macro. I have to do this one-by-one. I want this to be applied to multiple worksheets without having to activate and click anything.


Sub HELPPlease()

Sheets("CopyPaste").Range("A4:BD9001").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A5:J5"), Unique:=False

Dim strFormulas(1 To 3) As Variant

With ActiveSheet
strFormulas(1) = "=I6/F6*100000"
strFormulas(2) = "=VLOOKUP(D6,ISIN!$A$3:$C$370,3,FALSE)"
strFormulas(3) = "=L6-K6"

.Range("K6:M6").Formula = strFormulas

Dim LastPopulatedRow As Long

'Find last populated row
LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
'Select the rows where formula is to be populated
Range("K6: " & "M" & LastPopulatedRow).FillDown

End With

End Sub

Any help is greatly appreciated! Thank you

 

[dmt32]

Hi,
welcome to forum

You could list all the worksheets your code applies to in an array & loop through it

Untested - Place code in a standard module

Sub HELPPlease()
    Dim strFormulas(1 To 3) As Variant, ws As Variant
    Dim LastPopulatedRow As Long
   
    strFormulas(1) = "=I6/F6*100000"
    strFormulas(2) = "=VLOOKUP(D6,ISIN!$A$3:$C$370,3,FALSE)"
    strFormulas(3) = "=L6-K6"
   
    For Each ws In Worksheets(Array("Sheet1", "Sheet2", "Sheet3"))
   
    Sheets("CopyPaste").Range("A4:BD9001").AdvancedFilter Action:=xlFilterCopy, _
                        CriteriaRange:=ws.Range("A1:A2"), CopyToRange:=ws.Range("A5:J5"), Unique:=False
    With ws
        .Range("K6:M6").Formula = strFormulas
        'Find last populated row
        LastPopulatedRow = .Range("A" & .Rows.Count).End(xlUp).Row
        'Select the rows where formula is to be populated
        .Range("K6: " & "M" & LastPopulatedRow).FillDown
    End With
    Next ws
   
End Sub

If I read your post correctly, each sheet has a criteria range?

Add / Adjust sheet names shown in bold as required

Dave