在具有不同工作表名称的新工作簿中多次复制模板工作表

时间:2015-12-29 02:14:55

标签: excel vba excel-vba

第一次尝试完成VBA例程。

目标是:

使用每个单元格中具有不同名称的垂直范围的单元格在一个新工作簿中创建多个工作表。

这是我到现在所得到的:

Sub AddWorksheet()

Dim plage As Range
Dim i As Integer
Dim titre As String
Dim wb As Workbook

Set plage = Range("E6:E24")

Set wb = Workbooks.Add("New Workbook")

For i = 1 To plage.Height

If plage.Cells(i).Value <> "" Then
titre = plage.Cells(i).Value

ActiveWorkbook.Sheets("FeuilleTemplate").Copy After:=wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.Count).Activate
ActiveSheet.Name = titre

End If

Next i

End Sub

到目前为止,以下一行给我带来了困难:

Set wb = Workbooks.add("New Worbook")

错误消息是:错误执行&#39; 1004&#39; : 方法&#39; dd&#39;对象&#39;工作簿&#39;失败了。

我很难阅读并查找有关方法和类如何工作的信息

我使用java。

对于那些希望通过这个来帮助我的人来说,这是个好消息。

1 个答案:

答案 0 :(得分:1)

我认为我们无法添加具有指定名称的工作簿,因为它尚未保存。因此,只需添加工作簿执行所有操作,最后使用所需名称保存。

Sub AddWorksheet()
Application.DefaultSaveFormat = xlOpenXMLWorkbook
Dim plage As Range
Dim i As Integer
Dim OldBook As Workbook, NewBook As Workbook 'declare both workbooks
Set OldBook = ActiveWorkbook
spath = ThisWorkbook.Path
Set plage = OldBook.Sheets("Sheet Names").Range("E6:E24") 'Assuming that sheet names are in range E6:E24 in "Sheet Names" sheet in old workbook
Set NewBook = Workbooks.Add 'adding new workbook so as to copy the template sheet but this workbook is not saved yet
For i = 1 To plage.Height
    If plage.Cells(i).Value <> "" Then 'for each non blank cell in range
        OldBook.Sheets("FeuilleTemplate").Copy After:=NewBook.Sheets(NewBook.Sheets.Count) 'Copy "FeuilleTemplate" sheet in workbook after last sheet
        NewBook.Sheets("FeuilleTemplate").Name = plage.Cells(i).Value 'Rename the sheet to the desired names from range E6:E24 in "Sheet Names" sheet in old workbook
    End If
Next i
With NewBook
    .SaveAs Filename:=spath & "\" & "New Workbook with Templates"
    .Close SaveChanges:=True
     End With
End Sub