Передача кода рабочей книги в модуль повреждает переменную UsedRange.Rows

Question

Я перемещаю свой код на кнопки, чтобы пользователь мог использовать их без необходимости заходить на вкладку Dev и вручную запускать фрагменты кода.

Один из фрагментов позволяет пользователю разделить файл на основе того, что в столбце x указано (имеется в виду для каждого значения новый файл, который он создает), этот код сохраняется непосредственно в коде рабочей книги. С чем я сталкиваюсь при перемещении кода в модуль (для запуска на кнопках) отображается ошибка в переменной UsedRange.Rows, которая копирует содержимое этой ячейки в этот новый файл. Я попытался создать переменную листа, но она все еще показывает, что переменная UsedRange.Rows не определена.

Option Explicit
'CORTA LOS DATOS EN BASE AL RESPOSABLE ASIGNADO
Sub splitRespVP()

    Dim wb As Workbook
    Dim p As Range

    Application.ScreenUpdating = False

    '''''''''''
    Dim key As Variant
    Dim d As Object, i As Long, lr As Long
    Set d = CreateObject("Scripting.Dictionary")
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lr
      d.Item(Range("T" & i).Value) = 1
    Next i
    '''''''''''

    Application.DisplayAlerts = False
    Application.EnableEvents = False

    For Each key In d.Keys()
        Workbooks.Add
        Set wb = ActiveWorkbook
        ThisWorkbook.Activate

        WritePersonToWorkbook wb, key 'd.Item

        wb.SaveAs ThisWorkbook.Path & "\sdoRespVP_" & key
        wb.Close
    Next key
    Application.ScreenUpdating = True
    Set wb = Nothing

    Application.DisplayAlerts = True
    Application.EnableEvents = True

    MsgBox "Terminé."

End Sub

'ESCRIBE LOS DATOS PERTENECIENTE A ALGUN RESPONSABLE DEL DICCIONARIO
Sub WritePersonToWorkbook(ByVal respWB As Workbook, _
                          ByVal Person As String)
    Dim rw As Range
    Dim personRows As Range     '
    Dim firstRW As Range        '
    For Each rw In UsedRange.Rows 'HERE IS THE ERROR!
        If Not Not firstRW Is Nothing And Not IsNull(rw) Then
            Set firstRW = rw  '
        End If
        If Person = rw.Cells(1, 20) Then
            If personRows Is Nothing Then
                Set personRows = firstRW
                Set personRows = Union(personRows, rw)
            Else
                Set personRows = Union(personRows, rw)
            End If
        End If
    Next rw

    personRows.Copy respWB.Sheets(1).Cells(1, 1)
    Set personRows = Nothing
End Sub

Answer 1

Вам необходимо указать, для какого листа вы хотите использовать UsedRows. Например, если вы хотите использовать любой лист, выбранный пользователем в данный момент, вы можете сделать это:

'ESCRIBE LOS DATOS PERTENECIENTE A ALGUN RESPONSABLE DEL DICCIONARIO
Sub WritePersonToWorkbook(ByVal respWB As Workbook, _
                          ByVal Person As String)
    Dim rw As Range
    Dim personRows As Range     '
    Dim firstRW As Range        '

    Dim ws As Worksheet
    Set ws = ActiveSheet 'Get whatever worksheet the user happens to have selected

    For Each rw In ws.UsedRange.Rows 'HERE IS THE ERROR!
        If Not Not firstRW Is Nothing And Not IsNull(rw) Then
            Set firstRW = rw  '
        End If
        If Person = rw.Cells(1, 20) Then
            If personRows Is Nothing Then
                Set personRows = firstRW
                Set personRows = Union(personRows, rw)
            Else
                Set personRows = Union(personRows, rw)
            End If
        End If
    Next rw
    personRows.Copy respWB.Sheets(1).Cells(1, 1)
    Set personRows = Nothing
End Sub

Обратите внимание, что вы должны указать рабочую книгу и название нужного листа; ActiveSheet только для демонстрационных целей.