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

所以我在本地运行这个代码,使用一个我正在处理的数据表,这个代码需要在一定范围内抓取date以及所有的行,并把它放到一个新的工作簿中进行处理。 它在本地级别上工作得很好,我完全没有问题,但是当我将模块移动到PERSONAL.XLSB ,如果我修复了错误消息(在下面的代码中内联列出)以及另一个错误消息问题。 我的问题是如何创build它,以便我可以在每个电子表格中全局使用此工具,而无需复制和粘贴代码以正常工作?

 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创build模块时,它开始给出错误并且不起作用。 任何帮助将是伟大的!

原版的

ActiveWorkbook更改为ActiveWorkbook 。 根据这个 :

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

ActiveWorkbook将参考活动的工作簿

因此,当您将代码移动到PERSONAL.XLSB ,对ThisWorkbook所有引用突然指向PERSONAL.XLSB而不是包含数据的工作簿。 PERSONAL.XLSB当然没有你期望的input工作表结构!

编辑

还有一个皱纹! 当您调用Workbooks.Add ,新的工作簿将变为ActiveWorkbook 。 所以你需要的是:

 ... Dim wbkInput As Workbook ' ### New Dim wbkOutput As Workbook ... 'Set references up-front lngDateCol = 1 '<~ we know dates are in column A set wbkInput = ActiveWorkbook ' ### New - **before** creating the new workbook Set wbkOutput = Workbooks.Add For Each wks in wbkInput.Worksheets ' ### Don't use ActiveWorkbook from here on down ...