在新路径中保存新书的VBA错误

时间:2019-07-17 02:41:17

标签: excel vba

我的vba编码是否存在任何错误?我已经在工作簿中的单元格B4上输入了文件位置,并在单元格B5上输入了文件名。我想用多个命名工作表创建一个新的工作簿。有人可以帮我检查吗?谢谢!

Sub AddNewWorkbook1()

Dim FiLe As String
Dim Filepath As String
Dim Period As String

Worksheets("Sheet1").Range("B4") = FiLe
Worksheets("Sheet1").Range("B5") = Filepath
Worksheets("Sheet1").Range("E2") = Period

'Adding New Workbook
Workbooks.Add

'Saving the Workbook
ActiveWorkbook.SaveAs FiLe & Filepath

'Add new sheets with colored tabs
Worksheets.Add().Name = Period & "DTH&TPD"
Worksheets(Period & "DTH&TPD").Tab.ColorIndex = 39
Worksheets.Add().Name = "DTH&TPD" & "Claims List"
Worksheets("DTH&TPD" & "Claims List").Tab.ColorIndex = 39
Worksheets.Add().Name = Period & "Accidental Claims"
Worksheets(Period & "Accidental Claims").Tab.ColorIndex = 33
Worksheets.Add().Name = "Accidental Claims List"
Worksheets("Accidental Claims List").Tab.ColorIndex = 33
Worksheets("Sheet1").Delete

结束子

1 个答案:

答案 0 :(得分:0)

发布代码时,这里的最佳做法是始终提供有关实际问题的描述。您遇到错误了吗?如果是,那是什么,在哪一行?

也就是说,试试这个:

Sub AddNewWorkbook1()

    Dim FileName As String
    Dim FilePath As String
    Dim Period As String
    Dim wb As Workbook

    FilePath = Worksheets("Sheet1").Range("B4")
    FileName = Worksheets("Sheet1").Range("B5")
    Period = Worksheets("Sheet1").Range("E2")

    Set wb = Workbooks.Add() 'Adding New Workbook
    wb.SaveAs FilePath & FileName 'Save

    'Add new sheets with colored tabs
    AddSheetWithNameAndColor wb, Period & "DTH&TPD", 39
    AddSheetWithNameAndColor wb, "DTHTPD" & "Claims List", 39
    AddSheetWithNameAndColor wb, Period & "Accidental Claims", 33
    AddSheetWithNameAndColor wb, "Accidental Claims List", 33

    Application.DisplayAlerts = False 'turn off warning about delete
    wb.Worksheets("Sheet1").Delete
    Application.DisplayAlerts = True  'turn warnings back on
End Sub

'sub to add a sheet, name it, and change the tab colorindex
Sub AddSheetWithNameAndColor(wb As Workbook, sName As String, clr As Long)
    With wb.Worksheets.Add()
        .Name = sName
        .Tab.ColorIndex = clr
    End With
End Sub