Question

我将代码移到按钮上，以便用户无需进入“开发”选项卡和手动运行代码段即可使用它们。

其中一个片段允许用户根据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仅用于演示目的。

将工作簿代码传输到模块会损坏UsedRange.Rows变量

1 个答案: