【原创】VBA学习笔记（34）【例子】---创建新工作簿和写入内容，创建多个sheet

参考

参照以下文章学习练习
https://blog.csdn.net/qq_41816368/article/details/80957796 

一 创建一个新工作簿，并写点东西进去

Sub create_new_wb()
Dim wb As Workbook    '这个定义可以不要，不知道后面会不会有问题
Dim sh As Worksheet   '这个定义可以不要，不知道后面会不会有问题

Set wb = Workbooks.Add
wb.SaveAs Filename:="C:\VBA\101.xls"  '不能直接创建xlsm
Rem Set sh = wb.ActiveSheet           '这个是因为知道，创建workbooks时会自带3个sheet
Set sh = wb.Worksheets.Add

With sh
     .Name = "new"
     .Range("a1:d1") = Array("ID", "属性1", "属性2", "属性3")
End With

End Sub

二 创建多个工作表呢？

2.1 创建多个工作表

city1

city2

city3

city4

city5

city6

city7

city8

city9

city10

Sub t2()

Dim sh As Worksheet

For i = 1 To 10
   Worksheets.Add
   ActiveSheet.Name = Sheets("create").Cells(i, 1)
Next i


End Sub

2.2 批量创建新工作表，改进

• 表可以先不打开，VBA执行时打开

Sub t2()

Dim wb As Workbook
Dim i As Integer
i = 1
Rem 必须先打开这个表，才可以操作往里面加sheet
Set wb = Workbooks.Open("C:\VBA\100.xls")  '这个表开着也可以，不影响。


Do While wb.Sheets("create").Cells(i, 1) <> ""   '不用指定循环数，但中间有空还是不行
   wb.Worksheets.Add after:=wb.Worksheets(Worksheets.Count)  '新表往前放置
   wb.ActiveSheet.Name = wb.Sheets("create").Cells(i, 1)
   i = i + 1
Loop

End Sub

Rem 接下来想试验几个，批量删，从其他表读表名，可以跳过空格找数据？

这个报错

Rem 接下来想试验几个  从其他表读表名? 会报告数据源链接更新的问题

Sub t2()
Dim wb1 As Workbook
Dim wb As Workbook
Dim i As Integer
i = 1
Rem 必须先打开这个表，才可以操作往里面加sheet


Workbooks.Open Filename:="C:\VBA\cs2.xlsm" '这个是我的操作表，我现在肯定开着
Set wb = Workbooks.Open("C:\VBA\100.xls")  '这个表开着也可以，不影响。



Do While Workbooks("C:\VBA\cs2.xlsm").Sheets("create").Cells(i, 1) <> ""    '不用指定循环数，但中间有空还是不行
   wb.Worksheets.Add after:=wb.Worksheets(Worksheets.Count)  '新表往前放置
   wb.ActiveSheet.Name = Workbooks("C:\VBA\cs2.xlsm").Sheets("create").Cells(i, 1)
   i = i + 1
Loop

End Sub

Sub WbInput()
    Dim wb As String, xrow As Integer, arr  '定义 arr 变量的类型是Variant'
    wb = "E:\1_temp\excel VBA\employees.xls"
    Workbooks.Open (wb)
    With ActiveWorkbook.Worksheets(1)
        xrow = .Range("A1").CurrentRegion.Rows.Count + 1 '.Count 获取行号'
        arr = Array(xrow - 1, "Arye", "Female", #7/8/1987#, "2010")
        .Cells(xrow, 1).Resize(1, 6) = arr
    End With
    ActiveWorkbook.Close savechanges:=True
End Sub