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

做~自己de王妃 提交于 2021-02-04 21:37:23

问题


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 :)


回答1:


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


来源:https://stackoverflow.com/questions/56377185/how-can-i-run-these-macros-together-across-every-worksheet-in-the-workbook

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!