如何从名称为 InputBox 的工作表创建新工作簿

Question

我有两张纸。一个是模板，另一个是列表。我设法构建了一个代码，以使用偏移函数根据模板中的数据自动填充列表。脚本的最后一位包含错误。我想要实现的是从模板创建一个新工作簿，并以您可以在窗口中键入的名称保存，因此 InputBox 功能。

仅供参考，模板是"NCR 操作记录" 列表是"数据">

Sub Macro()
Dim strNCRReference As String, strType As String
Dim strOpenDate As String, strSupplierName As String
Dim strPartNo As String, Qty As Integer
Dim wb As Workbook
Dim wbName As String

Worksheets("NCR ACTION RECORD").Activate
strNCRReference = Range("A4")
strType = Range("B4")
strOpenDate = Range("C4")
strSupplierName = Range("F4")
strPartNo = Range("G4")
Qty = Range("H4")
Worksheets("Data").Activate
Range("A1").Activate
Do
  If ActiveCell.Value = "" Then Exit Do
  ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.Value = strNCRReference
ActiveCell.Offset(0, 3).Value = strType
ActiveCell.Offset(0, 1).Value = strOpenDate
ActiveCell.Offset(0, 6).Value = strSupplierName
ActiveCell.Offset(0, 8).Value = strPartNo
ActiveCell.Offset(0, 10).Value = Qty
Worksheets("NCR ACTION RECORD").Activate
  Set wb = Workbook.Add
ThisWorkbook.Activate
ThisWorkbook.Sheets("NCR ACTION RECORD").Copy Before:=wb.Sheets(1)
wb.Activate
wbName = InputBox("Enter a name of a new sheet")
wb.SaveAs "C:UsersS7051895DesktopwbName.xlsx"
End Sub

错误

是运行时错误"424"需要对象。

Answer 1

你在代码中做了一些错别字：

1 ： Workbooks.Add而不是Workbook.Add

2 ： wb.SaveAs "C:UsersS7051895Desktop" & wbName & ".xlsx"而不是wb.SaveAs "C:UsersS7051895DesktopwbName.xlsx"

所以你的代码会是这样的

Sub Macro()
    Dim strNCRReference As String, strType As String
    Dim strOpenDate As String, strSupplierName As String
    Dim strPartNo As String, Qty As Integer
    Dim wb As Workbook
    Dim wbName As String

    If ActiveSheet.Name <> "NCR ACTION RECORD" Then Worksheets("NCR ACTION RECORD").Activate

    strNCRReference = Range("A4")
    strType = Range("B4")
    strOpenDate = Range("C4")
    strSupplierName = Range("F4")
    strPartNo = Range("G4")
    Qty = Range("H4")
    Worksheets("Data").Activate
    Range("A1").Activate
    Do
      If ActiveCell.Value = "" Then Exit Do
      ActiveCell.Offset(1, 0).Activate
    Loop
    ActiveCell.Value = strNCRReference
    ActiveCell.Offset(0, 3).Value = strType
    ActiveCell.Offset(0, 1).Value = strOpenDate
    ActiveCell.Offset(0, 6).Value = strSupplierName
    ActiveCell.Offset(0, 8).Value = strPartNo
    ActiveCell.Offset(0, 10).Value = Qty
    Worksheets("NCR ACTION RECORD").Activate
      Set wb = Workbooks.Add
    ThisWorkbook.Activate
    ThisWorkbook.Sheets("NCR ACTION RECORD").Copy Before:=wb.Sheets(1)
    wb.Activate
    wbName = InputBox("Enter a name of a new sheet")
    wb.SaveAs "C:UsersS7051895Desktop" & wbName & ".xlsx"

结束子

Answer 2

It's Workbooks.添加，而不是工作簿。尝试在我的计算机上的 test-sub 中使用后者，我在包含该代码的行上收到错误"变量未定义"，我认为您收到不同错误的原因是因为当您尝试稍后在代码中与它交互时尚未设置工作簿对象。

作为对您的代码的附加评论，我建议您使用

With Worksheets("NCR ACTION RECORD")
    strNCRReference = .Range("A4")
    ...
End With

而不是Worksheets("NCR ACTION RECORD").Activate然后在该工作表上执行操作。前者更加健壮，除了执行更快的代码。