Отделить лист от исходного листа, используя объединение в коде проблемы

Question

У меня есть книга Excel с 2 листами.Один называется «Группировка» и хранит много названий отделов.На другом листе хранятся записи о сотрудниках, такие как название отдела, возраст, имя, зарплата ....

Я хочу создать рабочие листы, используя название отдела

При запуске этого кода генерируется тольколист для отдела маркетинга, а затем выдает ошибку.Ошибка показывает

Метод «Объединение» объекта «_Global» не удалось.

Может кто-нибудь сказать мне проблему, вызвавшую эту ошибку?

Sub Extract()

Dim myCell As Range
Dim Rng As Range
Dim Rng_Del As Range
Dim source_sht As Worksheet
Dim use_sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Dim sheet_name As String
Dim gp_Lastrow As Long

gp_Lastrow = Worksheets("Grouping").Cells(Rows.Count, 1).End(xlUp).Row

For a = 2 To gp_Lastrow

    Set source_sht = Worksheets("Sheet1")
    source_sht.Copy After:=ThisWorkbook.Sheets(2)
    ActiveSheet.Name = Worksheets("Grouping").Range("A" & a).Value

    sheet_name = Worksheets("Grouping").Range("A" & a).Value
    Worksheets(sheet_name).Activate
    Set use_sht = Worksheets(sheet_name)

    Set StartCell = use_sht.Range("A2")
    LastRow = use_sht.Cells(use_sht.Rows.Count, StartCell.Column).End(xlUp).Row
    LastColumn = use_sht.Cells(StartCell.Row, use_sht.Columns.Count).End(xlToLeft).Column

    Set Rng = use_sht.Range(StartCell, use_sht.Cells(LastRow, LastColumn))

    If use_sht.AutoFilterMode = True Then
        use_sht.AutoFilter.ShowAllData
    End If

    Rng.AutoFilter field:=1, Criteria1:=Worksheets("Grouping").Range("A" & a).Value

    'Delete hidden rows
    For Each myCell In Rng.Columns(1).Cells
        If myCell.EntireRow.Hidden Then
            If Rng_Del Is Nothing Then
                Set Rng_Del = myCell
            Else
                Set Rng_Del = Union(Rng_Del, myCell)
            End If
        End If
    Next

    If Not Rng_Del Is Nothing Then Rng_Del.EntireRow.Delete

    use_sht.AutoFilterMode = False
Next a


End Sub

После запуска кода предположим, что файлы должны содержать следующие листы:

Например: Группировка, Лист1 (Группировка и Лист1 - вкладка исходных листов в файлах), отдел рынка (есть толькоштатное расписание, связанное с отделом рынка), человеческие ресурсы (есть только штатное расписание, связанное с отделом кадров), финансовый отдел, отдел кассового контроля

В будущем будет больше отделовдобавлено, если компания расширяется.

Answer 1

Вы не очищаете Rng_Del между листами, поэтому вы пытаетесь объединить диапазоны между двумя разными листами: вот что выдает ошибку.

Set Rng_Del = Nothing '<<<<<<< clear before entering the loop
'Delete hidden rows
For Each myCell In Rng.Columns(1).Cells
    If myCell.EntireRow.Hidden Then
        If Rng_Del Is Nothing Then
            Set Rng_Del = myCell
        Else
            Set Rng_Del = Union(Rng_Del, myCell)
        End If
    End If
Next
If Not Rng_Del Is Nothing Then Rng_Del.EntireRow.Delete