Apply a 1 macro vba for all files which are open right now?-CodePudding

as all i have a repeating work which i need to do on daily basis.

as i am a complete noob and my complete macro list which i have created is by reading here maybe you could help me out with one macro

is there a possiblity the macro from below to change that it will apply for all already open workbooks ?

Sub copyDown()

Dim myCount As Double

myCount = WorksheetFunction.CountA(Range("B:B"))

Range("ab2:ad" & myCount).FillDown


End Sub

Sub columnA()
    
    Dim myfirstRow, myLastrow As Integer
    
    myfirstRow = WorksheetFunction.CountA(Range("A:A"))   1
    myLastrow = WorksheetFunction.CountA(Range("B:B"))
    
    Range("a" & myfirstRow & ":a" & myLastrow).Formula = "=TODAY() - 1"
    Range("a" & myfirstRow & ":a" & myLastrow).Select
    Selection.Copy
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
End Sub

both sub i need to do in 5 files where each file have 2 specific sheets

in theory i know i could arrange it a bit different but my original macro have around 1600 lines and i am afraid to touch the running macro which i have build now for 2weeks :S

thank you all

CodePudding user response：

This is how to create a separate sub that will find each workbook then call your original sub, passing it the worksheet it should work on.

I've only done it for "CopyDown", but it's exactly the same process.

Option Explicit
Sub Iterate_Workbooks()

    Dim WB As Workbook
    
    For Each WB In Application.Workbooks
        ' This is a way to exclude open workbooks from your search
        ' OR remove the "not" to include withbooks with only certain 
        '   text in their name. "*" is wildcard, see some examples:
        'If Not WB.Name Like "Master*" Then
        'If WB.Name Like "FillerBook # *" Then
        If Not WB.Name Like "*.xlsm" Then
            Call copyDown(WB.Worksheets(1))
        End If
    Next WB
    
End Sub
Sub copyDown(WS As Worksheet)

    Dim myCount As Double
    
    With WS
        myCount = WorksheetFunction.CountA(.Range("B:B"))
        .Range("ab2:ad" & myCount).FillDown
    End With

End Sub

CodePudding user response：

You can create a function that would go through all the open workbooks and from each work book it will go through all the sheets and match the name of the sheets to call your subroutines columnA and copyDown by passing the sheet reference, hope this helps!

Sub ProcessAllWorkbooks()
    Dim WB As Workbook, WS As Worksheet
    
    For Each WB In Workbooks
        For Each WS In WB.Sheets
            If UCase(WS.Name) = "WHATEVER_NAME_OF_COPY_DOWN_SHEET_IN_UPPERCASE" Then
                Call copyDown(WS)
            ElseIf UCase(WS.Name) = "WHATEVER_NAME_OF_COLUMNa_SHEET_IN_UPPERCASE" Then
                Call columnA(WS)
            End If
        Next
    Next

End Sub

Sub copyDown(processWS As Worksheet)
Dim myCount As Double
    
    With processWS
        .Activate
        .Range("B1").Select
        myCount = WorksheetFunction.CountA(Range("B:B"))
        Range("ab2:ad" & myCount).FillDown
    End With
End Sub

Sub columnA(processWS As Worksheet)
    
    Dim myfirstRow, myLastrow As Integer
    
    With processWS
        .Activate
        .Range("A1").Select
        myfirstRow = WorksheetFunction.CountA(Range("A:A"))   1
        myLastrow = WorksheetFunction.CountA(Range("B:B"))
        
        Range("a" & myfirstRow & ":a" & myLastrow).Formula = "=TODAY() - 1"
        Range("a" & myfirstRow & ":a" & myLastrow).Select
        Selection.Copy
        
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
    End With
End Sub