Применение одного и того же макроса ко всем рабочим листам - PullRequest
Новая
       7

Применение одного и того же макроса ко всем рабочим листам

0 голосов
/ 29 августа 2018

Я пытаюсь запустить макрос на всех листах в книге Excel. У меня есть код ниже, но я получаю ошибку времени выполнения «1004»: сбой метода «Объединение» объекта «_Global».

Я посмотрел на ошибку и попытался "зайти в Инструменты / Параметры и выбрать опцию Требовать объявление переменной" из предложенного ниже предложения, но это не сработало.

Метод 'Объединение' объекта '_Global' не выполнен для ячеек, находящихся на одном листе

Ниже приведен мой код VBA, который будет проходить по всем рабочим листам. 

    Sub Bagasse_YG_Update()

    Dim rng As Range, column As Long, row As Long
    Dim WS_Count As Integer
    Dim I As Integer

    ' Set WS_Count equal to the number of worksheets in the active
    ' workbook.
    WS_Count = ActiveWorkbook.Worksheets.Count

    ' Begin the loop.
    For I = 1 To WS_Count

    'do whatever you need'
    Sheets(I).Select ' Added this command to loop through the sheets

    Range("A1").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Union(ActiveCell.EntireRow, ActiveCell.Resize(1).Offset   (-1).EntireRow).Copy
    ActiveCell.Resize(1).Offset(1).EntireRow.Insert Shift:=xlDown
    Application.CutCopyMode = False

    For column = 4 To 43
        If (column + 1) Mod 4 > 0 Then
            For row = 1 To 2
                If rng Is Nothing Then
                    Set rng = ActiveCell.Offset(row, column)
                Else
                    Set rng = Union(rng, ActiveCell.Offset(row, column))
                End If
                Next row
            End If
            Next column
            rng.ClearContents

    ActiveCell.End(xlDown).Select
    ActiveCell.End(xlDown).Select
    ActiveCell.Offset(-6).EntireRow.Copy
    ActiveCell.Offset(-5).Select
    ActiveCell.EntireRow.Insert Shift:=xlDown
    Application.CutCopyMode = False



    Dim row2 As Long, column2 As Long
    row2 = -2
    For column2 = 5 To 25 Step 4
        ActiveCell.Offset(row2, column2).Copy
        ActiveSheet.Paste Destination:=ActiveCell.Offset(row2 + 1, column2)
        Next column2

    Next I
  Exit Sub
End Sub

1 Ответ

0 голосов
/ 29 августа 2018

Похоже, вам нужно сбросить rng на Nothing, прежде чем переходить к следующему листу: 

...
Next column
rng.ClearContents

Set rng = Nothing
...

Чтобы расширить мои комментарии:

Когда вы попали на Sheet2, ваша первая итерация этого цикла 

If rng Is Nothing Then
    Set rng = ActiveCell.Offset(row, column)
Else
    Set rng = Union(rng, ActiveCell.Offset(row, column))
End If

Идет прямо к Set rng = Union(rng, ActiveCell.Offset(row, column)), потому что rng не был сброшен до Nothing. Затем он пытается Union на двух листах, что вы не можете сделать.

...