为什么sub的这个调用不能正常工作？ 我得到一个错误，有未定义的对象。 我相信这可能是一个小问题但无法找到解决方案。 我正在尝试制作新的工作表名称，但代码对于VBA来说太长了，所以我必须拆分代码，然后继续使用第二个Sub。 （显然它仅限于16个处理中的15个）
提前致谢。
低于我的开始代码
Sub Macro1()
' Macro1 Macro
Dim wbNew As Workbook
'sheet 1----------------------------------------------------------------
Application.ScreenUpdating = False
ThisWorkbook.Sheets(1).Activate
Range("A1:S53").Select
Range("S53").Activate
Selection.Copy
Set wbNew = Workbooks.Add
wbNew.Sheets(1).Activate
Range("A1:S53").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
wbNew.Sheets(1).Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
ActiveSheet.Paste
Range("A15").Select
Call vanaf_17
ActiveWorkbook.SaveAs Filename:= _
"C:\Path\" & "per 1-15" & " " & Format(Range("C13"), "mmmm") & " " & Format(Range("C13"), "YYYY") & ".xlsx"
FileFormat = xlOpenXMLWorkbook
ActiveWindow.Close
End Sub
要调用的代码
Sub vanaf_17()
Dim wbNew As Workbook
Application.ScreenUpdating = False
'sheet 17----------------------------------------------------------------
'here starts a new sheet!!!!!!!!!!!!!
Sheets.Add After:=ActiveSheet
ThisWorkbook.Sheets(1).Activate
Range("A1:S53").Select
Range("S53").Activate
Selection.Copy
'change here sheet nr!!!!!!!
wbNew.Sheets(17).Activate
Range("A1:S53").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'change here sheet nr!!!!!!!
wbNew.Sheets(17).Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
ActiveSheet.Paste
'Here ends a new sheet!!!!!
End Sub
答案 0 :(得分：1)
您还需要在第二个子设置中设置wbnew。当你说wbnew时，第二个小组不知道你的意思。当子程序或函数中有变量时，它只存在于子程序或函数中。一旦你移动到另一个子程序，你的变量100％毫无价值。
要解决此问题，您可以在subs之间传递参数。
当您开始第二个子Sub vanaf_17()时，请执行以下操作：
Sub vanaf_17(wbNew as Workbook)
....your code
End Sub
当您致电vanaf_17()时，请执行以下操作：
Call vanaf_17 webNew
此外，由于您在参数中将webNew声明为工作簿，因此请删除dim wbNew as Workbook中的vanaf_17位，否则您将收到错误。
最后，没有理由需要将它们分成两个子程序。我从未听说过'15或16处理'的限制，我不确定这意味着什么。我已经看到了一些丑陋的ass记录宏代码，这些宏代码继续存在数千行.select和.activate以及oh-my-god-no-that-is-such-a-bad-idea，感觉永远都是这样。 Excel可以处理它。
更新：以下是此更改的代码：
Sub Macro1()
' Macro1 Macro
Dim wbNew As Workbook
'sheet 1----------------------------------------------------------------
Application.ScreenUpdating = False
ThisWorkbook.Sheets(1).Activate
Range("A1:S53").Select
Range("S53").Activate
Selection.Copy
Set wbNew = Workbooks.Add
wbNew.Sheets(1).Activate
Range("A1:S53").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
wbNew.Sheets(1).Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
ActiveSheet.Paste
Range("A15").Select
Call vanaf_17 wbNew
ActiveWorkbook.SaveAs Filename:= _
"C:\Path\" & "per 1-15" & " " & Format(Range("C13"), "mmmm") & " " & Format(Range("C13"), "YYYY") & ".xlsx"
FileFormat = xlOpenXMLWorkbook
ActiveWindow.Close
End Sub
Sub vanaf_17(wbNew AS Workbook)
Application.ScreenUpdating = False
'sheet 17----------------------------------------------------------------
'here starts a new sheet!!!!!!!!!!!!!
Sheets.Add After:=ActiveSheet
ThisWorkbook.Sheets(1).Activate
Range("A1:S53").Select
Range("S53").Activate
Selection.Copy
'change here sheet nr!!!!!!!
wbNew.Sheets(17).Activate
Range("A1:S53").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'change here sheet nr!!!!!!!
wbNew.Sheets(17).Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
ActiveSheet.Paste
'Here ends a new sheet!!!!!
End Sub
话虽如此，我认为这里有一些变化会有所帮助。也就是说，您可以遍历thisWorkbook中关注的所有工作表，并调用子例程将A1:S53范围复制并粘贴到新工作簿中的新工作表中。下面我有一个简短的例子。我在那里保留了一些不必要的.select和.activate内容，因为我认为这种变化足够引人注目。您将看到所有工作表创建和复制/粘贴现在都在第二个子例程中完成。第一个子例程只是设置新工作簿，遍历工作表，然后保存新工作簿。
Sub Macro1()
' Create a new workbook. Then loop through each worksheet in this workbook (that we care about)
' and call the CreateNewWS subroutine to copy the A1:S53 range for each worksheet into the
' new workbook
Application.ScreenUpdating = False
'Create a new workbook, assign it to wbNew variable
Dim wbNew As Workbook
Set wbNew = Workbooks.Add
'Loop through all the sheets in the current workbook that we care about
Dim sheetname as string
For each sheetname in Array("sheet1", "sheet2", "sheet3", "sheet4")
'call the CreateNewWS subroutine to do the sheet creation and copying and pasting
call CreateNewWS wbNew, thisWorkbook.Sheets(sheetname)
Next sheetname
'You could also loop through all of the worksheets in thisworkbook if you want to copy every worksheet:
'Dim ws as worksheet
'For each ws in ThisWorkbook.Worksheets
' call CreateNewWS wbNew, ws
'Next ws
'Save the new workbook
newWb.SaveAs Filename:= _
"C:\Path\" & "per 1-15" & " " & Format(Range("C13"), "mmmm") & " " & Format(Range("C13"), "YYYY") & ".xlsx"
FileFormat = xlOpenXMLWorkbook
'Close the new workbook
newWb.Close
'Don't forget to turn this back on. Yikes.
Application.ScreenUpdating = True
End Sub
Sub CreateNewWS(wbNew AS Workbook, ws as Worksheet)
'This subroutine takes in the wbNew and the worksheet (ws) that we are copying from.
' it copys range A1:S53 from the ws to the wbNew's new worksheet.
'This will hold the new worksheet we are adding to the wbNew
Dim wsNew as worksheet
'Add a new worksheet to the new workbook
wbNew.Activate
set wsNew = wbNew.Sheets.Add After:=ActiveSheet
'Activate and copy from current workbook
ws.Activate
ws.Range("A1:S53").Select
Selection.Copy
'Activate and paste into newWb
wsNew.Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub
我还没有真正测试过这种变化，但它的内涵是准确的。如果您决定切换到这种类型的逻辑并且遇到错误，那么创建一个新的stackoverflow问题以解决问题是明智的。