简体   繁体   中英

How can I run these macros together across every worksheet in the workbook?

I have made an excel book, where a data set is pasted into one tab, and macros are run to filter out the information into seperate worksheets, ready to batch PDF. Currently I have a button on each sheet to 'Update Table' and have to go through each sheet to click this button. I want this as one button on the first sheet. I also have a button to set the print area on all sheets - this one loops and works fine. I'd like to merge the codes, so one button will go through each sheet to update the tables, and then set the print area.

I have tried merging these codes together with no luck so far despite hours of googling, so thought I'd try here. I'm very new to VBA (just been teaching myself for a few weeks).

    Sub Auto_Table_Update()

        Sheets("All Data").Range("A50:K9999").AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Range("C2:C3"), CopyToRange:=Range("A5:K9999"), Unique:= _
            False
    '*Advance Filter Macro to update the table in the worksheet*


        Range("C4").Select
        ActiveCell.FormulaR1C1 = "=LEFT(R[-1]C,3)"
        Range("C5").Select
    '*Sets the worksheet name as the first 3 letters in cell C4*

    End Sub


    Sub Workbook_Print_Area()
    Dim ws      As Worksheet

    Dim LR      As Long, _
        LC      As Long

    For Each ws In ActiveWorkbook.Worksheets
        With ws
            LR = .Range("A" & Rows.Count).End(xlUp).Row
            LC = .Cells(1, Columns.Count).End(xlToLeft).Column
            .PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(LR, LC)).Address
            End With
    ' *sets the print area on every sheet*
    Next ws
    End Sub

Like I said, I just want one button to run the above codes on every sheet. Or at least the 'Auto_Update_Table' to be run on every sheet rather than having a button to run it on each sheet like I currently do.

I appreciate some of it will be badly coded.. Any explanations of the changes would be much appreciated too. I appreciate your patience.. I am trying to get my head around all this :)

UPDATE

I have tried doing this:

    Sub One_Button()
    Dim ws      As Worksheet

    Dim LR      As Long, _
        LC      As Long

    For Each ws In ActiveWorkbook.Worksheets

        With ws
            Sheets("All Data").Range("A50:K9999").AdvancedFilter Action:=xlFilterCopy, _
                CriteriaRange:=Range("C2:C3"), CopyToRange:=Range("A5:K9999"), Unique:= _
                False

            Range("C4").Select
            ActiveCell.FormulaR1C1 = "=LEFT(R[-1]C,3)"
            Range("C5").Select
            LR = .Range("A" & Rows.Count).End(xlUp).Row
            LC = .Cells(1, Columns.Count).End(xlToLeft).Column
            .PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(LR, LC)).Address
            End With
    Next ws
    End Sub

This gives me the error 'The extract range has a missing or invalid field name.' Is this because it is trying to run on the first worksheet (with the main data set)? If so, how do I tell it to ignore the main data set sheet? Thanks in advance :)

Can you try this? You need to make sure your criteria range includes the correct headers and doesn't have any spaces.

Sub One_Button()

Dim ws      As Worksheet
Dim LR      As Long, _
    LC      As Long

For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "All Data" Then
        With ws
            Sheets("All Data").Range("A50:K9999").AdvancedFilter Action:=xlFilterCopy, _
                     CriteriaRange:=ws.Range("C2:C3"), CopyToRange:=ws.Range("A5"), Unique:=False
            ws.Range("C4").FormulaR1C1 = "=LEFT(R[-1]C,3)"
            LR = .Range("A" & Rows.Count).End(xlUp).Row
            LC = .Cells(1, Columns.Count).End(xlToLeft).Column
            .PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(LR, LC)).Address
        End With
    End If
Next ws

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM