Как я могу запустить эти макросы вместе на каждом листе в книге? - PullRequest
0 голосов
/ 30 мая 2019

Я сделал книгу Excel, в которой набор данных вставляется в одну вкладку, и запускаются макросы для фильтрации информации в отдельных рабочих листах, готовых для пакетного PDF. В настоящее время у меня на каждом листе есть кнопка «Обновить таблицу», и мне нужно просмотреть каждый лист, чтобы нажать эту кнопку. Я хочу это как одну кнопку на первом листе. У меня также есть кнопка, чтобы установить область печати на всех листах - она ​​зацикливается и работает нормально. Я хотел бы объединить коды, поэтому одна кнопка будет проходить через каждый лист для обновления таблиц, а затем устанавливать область печати. ​​

Я пытался объединить эти коды вместе безуспешно, несмотря на часы поисков в Google, поэтому подумал, что попробую здесь. Я очень новичок в 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

Как я уже сказал, я просто хочу, чтобы одна кнопка запускала вышеуказанные коды на каждом листе. Или, по крайней мере, «Auto_Update_Table» для запуска на каждом листе, вместо того, чтобы иметь кнопку для запуска его на каждом листе, как я в настоящее время.

Я ценю, что некоторые из них будут плохо закодированы. Любые объяснения изменений также будут высоко оценены. Я ценю ваше терпение .. Я пытаюсь все это осмыслить :)

UPDATE

Я пытался сделать это:

    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

Это дает мне сообщение об ошибке «Диапазон извлечения содержит отсутствующее или неверное имя поля». Это потому, что он пытается работать на первом листе (с основным набором данных)? Если да, то как мне сказать, чтобы он игнорировал основную таблицу данных? Заранее спасибо:)

1 Ответ

0 голосов
/ 30 мая 2019

Можете ли вы попробовать это?Вы должны убедиться, что ваш диапазон критериев содержит правильные заголовки и не имеет пробелов.

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...