将宏从XLS移动到Personal.xlsb时出现“重复名称”错误

Question

所以我在本地级别上运行了这个代码，其中包含我正在使用的数据表，需要在一定范围内获取所有行的日期并将其放入一个新工作簿中进行处理上。它在本地级别上工作得非常好，我完全没有问题，但是当我将模块移动到PERSONAL.XLSB时，它会显示错误消息（在下面的代码中列为内联）如果我解决了问题，还会显示另一条错误消息。我的问题是如何创建它以便我可以在我的每个电子表格中全局使用它而无需复制和粘贴代码以使其正常工作？

Option Explicit

'This subroutine prompts the user to select dates
Public Sub PromptUserForInputDates()

Dim strStart As String, strEnd As String, strPromptMessage As String

'Prompt the user to input the start date
strStart = InputBox("Please enter the start date")

'Validate the input string
If Not IsDate(strStart) Then
    strPromptMessage = "Oops! It looks like your entry is not a valid " & _
                       "date. Please retry with a valid date..."
    MsgBox strPromptMessage
    Exit Sub
End If

'Prompt the user to input the end date
strEnd = InputBox("Please enter the end date")

'Validate the input string
If Not IsDate(strStart) Then
    strPromptMessage = "Oops! It looks like your entry is not a valid " & _
                       "date. Please retry with a valid date..."
    MsgBox strPromptMessage
    Exit Sub
End If

'Call the next subroutine, which will do produce the output workbook
Call CreateSubsetWorkbook(strStart, strEnd)

End Sub

'This subroutine creates the new workbook based on input from the prompts
Public Sub CreateSubsetWorkbook(StartDate As String, EndDate As String)

Dim wbkOutput As Workbook
Dim wksOutput As Worksheet, wks As Worksheet
Dim lngLastRow As Long, lngLastCol As Long, lngDateCol As Long
Dim rngFull As Range, rngResult As Range, rngTarget As Range

'Set references up-front
lngDateCol = 1 '<~ we know dates are in column A
Set wbkOutput = Workbooks.Add

'Loop through each worksheet
For Each wks In ThisWorkbook.Worksheets
    With wks

        'Create a new worksheet in the output workbook
        Set wksOutput = wbkOutput.Sheets.Add
        wksOutput.Name = wks.Name

       '------> I receive the first error here:
       'Run-Time error '1004':
       'That name is already taken. Try a different One
       'If I change the = wks.Name = "Sheet1" it gives another error of:
       'Run-time erro '91':
       'Object variable or With block variable not set

        'Create a destination range on the new worksheet that we
        'will copy our filtered data to
        Set rngTarget = wksOutput.Cells(1, 1)

        'Identify the data range on this sheet for the autofilter step
        'by finding the last row and the last column
        lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByRows, _
                             SearchDirection:=xlPrevious).Row

      '---------->Error Message here for the 2nd Error message

        lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByColumns, _
                             SearchDirection:=xlPrevious).Column
        Set rngFull = .Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol))

        'Apply a filter to the full range to get only rows that
        'are in between the input dates
        With rngFull
            .AutoFilter Field:=lngDateCol, _
                        Criteria1:=">=" & StartDate, _
                        Criteria2:="<=" & EndDate

            'Copy only the visible cells and paste to the
            'new worksheet in our output workbook
            Set rngResult = rngFull.SpecialCells(xlCellTypeVisible)
            rngResult.Copy Destination:=rngTarget
        End With

        'Clear the autofilter safely
        .AutoFilterMode = False
        If .FilterMode = True Then
            .ShowAllData
        End If
    End With
Next wks

'Let the user know our macro has finished!
MsgBox "Data transferred!"

End Sub

我还是VBA的新手所以请耐心等待，只是试着理解为什么它在本地级别工作完全正常但是当试图在PERSONAL.XLSB中创建模块时它开始给出错误并且不会起作用。任何帮助都会很棒！

Answer 1

原始

将ThisWorkbook更改为ActiveWorkbook。每this：

  

ThisWorkbook将始终引用代码所在的工作簿

     

ActiveWorkbook将引用活动的工作簿

因此，当您将代码移至PERSONAL.XLSB时，您对[{1}}的所有引用都突然指向ThisWorkbook，而不是包含您的数据的工作簿。 PERSONAL.XLSB当然没有您期望的输入工作表结构！

修改

还有一个皱纹！当您致电PERSONAL.XLSB时，新工作簿将变为Workbooks.Add 。所以你需要的是：

ActiveWorkbook