如果工作表上有数据，则尝试制作新的工作簿。

Question

如果工作表上有数据，则尝试制作新的工作簿。适用于一个工作表，但当它转到下一个工作表时，会得到“下标超出范围”的错误。

编辑3：

If WorksheetFunction.CountA(Workbooks("orders (3)").Worksheets("Sheet2").Range("A1:AY300")) = 0 And Workbooks("orders (3)").Worksheets("Sheet2").Shapes.Count = 0 Then
    Workbooks("orders (3)").Worksheets("Sheet2").Delete

    Else
    Dim sWorkbook As Workbook

    'Create New Workbook
    Set sWorkbook = Workbooks.Add

    'Save Above Created New Workbook
    sWorkbook.SaveAs Filename:="C:\CODE\11 Production.xlsx"
    End If


If WorksheetFunction.CountA(Workbooks("orders (3)").Worksheets("Sheet3").Range("A1:AY300")) = 0 And Workbooks("orders (3)").Worksheets("Sheet3").Shapes.Count = 0 Then
    Workbooks("orders (3)").Worksheets("Sheet3").Delete

    Else
    Dim sWorkbook1 As Workbook

    'Create New Workbook
    Set sWorkbook1 = Workbooks.Add

    'Save Above Created New Workbook
    sWorkbook1.SaveAs Filename:="C:\CODE\22 Production.xlsx"
    End If

If WorksheetFunction.CountA(Workbooks("orders (3)").Worksheets("Sheet4").Range("A1:AY300")) = 0 And Workbooks("orders (3)").Worksheets("Sheet4").Shapes.Count = 0 Then
    Workbooks("orders (3)").Worksheets("Sheet4").Delete

    Else
    Dim sWorkbook2 As Workbook

    'Create New Workbook
    Set sWorkbook2 = Workbooks.Add

    'Save Above Created New Workbook
    sWorkbook2.SaveAs Filename:="C:\CODE\33 Production.xlsx"
    End If

If WorksheetFunction.CountA(Workbooks("orders (3)").Worksheets("Sheet5").Range("A1:AY300")) = 0 And Workbooks("orders (3)").Worksheets("Sheet5").Shapes.Count = 0 Then
    Workbooks("orders (3)").Worksheets("Sheet5").Delete

    Else
    Dim sWorkbook3 As Workbook

    'Create New Workbook
    Set sWorkbook3 = Workbooks.Add

    'Save Above Created New Workbook
    sWorkbook3.SaveAs Filename:="C:\CODE\44 Production.xlsx"
    End If

If WorksheetFunction.CountA(Workbooks("orders (3)").Worksheets("Sheet6").Range("A1:AY300")) = 0 And Workbooks("orders (3)").Worksheets("Sheet6").Shapes.Count = 0 Then
    Workbooks("orders (3)").Worksheets("Sheet6").Delete

    Else
    Dim sWorkbook4 As Workbook

    'Create New Workbook
    Set sWorkbook4 = Workbooks.Add

    'Save Above Created New Workbook
    sWorkbook4.SaveAs Filename:="C:\CODE\55 Production.xlsx"
    End If

Answer 1

如果您不指定Workbook a Worksheet在其中，那么就会有一个隐式ActiveWorkbook。看起来活动工作簿是您刚才添加的工作簿，而不是原始工作簿。

尽管如此，这段代码可以简化为这样的代码：

Sub teststs()
    Dim ws as Worksheet
    For Each ws in ThisWorkbook.Worksheets
        If ws.Name <> "Sheet1" Then 'presumably you're skipping Sheet1, change as needed
             If WorksheetFunction.CountA(ws.Range("A1:AY300")) = 0 And ws.Shapes.Count = 0 Then
                  ws.Delete
             Else
                  Dim newWb as Workbook
                  Set newWb = Workbooks.Add

                  Dim i As Long
                  i = i + 11
                  newWb.SaveAs Filename:="C:\CODE\" & i & " Production.xlsx"              
             End If
        End If
    Next
End Sub