简体   繁体   English

如何在工作簿中的每个工作表上一起运行这些宏?

[英]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. 我已经制作了一本excel书,将数据集粘贴到一个选项卡中,并运行宏以将信息过滤成单独的工作表,准备批量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). 我是VBA的新手(刚刚自学了几个星期)。

    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. 或者至少要在每张纸上运行'Auto_Update_Table',而不是像我目前那样在每张纸上运行它。

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

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