如何在excel 用VBA插入多个工作表并命名。要用到宏。给分给分~

Posted 2023-04-23

在工作簿中插入49张工作表。将该工作簿的工作表依次命名为“第一周”、“第二周”、“第三周”……“第五十二周”。请给我详细的编程过程哈···。
不要说一张一张插入再一张一张改名这样的方法哈。。。。。。。。用VBA编程~~~~~

具体操作步骤如下：

1、第一步，打开Excel表格，在主界面按Alt+f11下快捷键，如图所示。

2、第二步，进入到VBA编辑器，点击上面菜单栏中的插入，再选择【模块】，如图所示。

3、第三步，在弹出的模块窗口中，输入下面的代码：

Option Explicit

Sub addwork()

Sheets.Add after:=Sheets(Sheets.Count)

End Sub，

如图所示。

4、第四步，输入好后，在编辑器的左侧，输入模块的名称。如图所示。

5、第五步，关闭编辑器窗口，返回到表格中，点击上方菜单栏中的视图，再点击下方菜单栏的宏，选择查看宏，如图所示。

6、最后一步，在弹出的宏窗口中，单击宏名，再单击【执行】就可以了，如图所示。

参考技术A

增加sheet的命令符为sheets.add

完整的表达式为Sheets.Add(Before, After, Count, Type)

before或after可分别设置增加的sheet在某个工作表前或表后，一般不用同时指定。如果同时指定则不要造成矛盾。

count,指增加的工作表个数。

type指增加的工作表类别。

如果批量增加，则需要指定定义sheet变量。

如下两种代码均可批量增加100个并重命名sheet。

Sub SheetAdd()
Dim myrange As Worksheet
Set myrange = Sheets.Add(Count:=100)
For i = 1 To 100
Worksheets(i).Name = i
Next
End Sub

 

Sub SheetAdd_()
For i = 1 To 100
Sheets.Add
ActiveSheet.Name = "a" & i
Next
End Sub

参考技术B Sub test()
Dim intWeeks As Integer
intWeeks = 1

'将工作簿中的工作表个数增加到52个
While Sheets.Count < 52
Sheets.Add After:=Sheets(Sheets.Count)
Wend

'将这52个工作表按“第一周”“第二周”…“第五十二周”的格式重命名
For i = 1 To Sheets.Count
Sheets(i).Name = "第" & Application.ExecuteExcel4Macro("NUMBERSTRING(" & intWeeks & ",1)") & "周"
intWeeks = intWeeks + 1
Next i
End Sub 参考技术C Sub ShtAdd()
Dim i%
For i = 1 To 49
If i > Worksheets.Count Then Worksheets.Add after:=Worksheets(Sheets.Count)
Worksheets(i).Name = "第" & WorksheetFunction.Text(i, "[dbnum1]") & "周"
Next i
End Sub本回答被提问者采纳

如何将行从一个 Excel 工作表复制到另一个工作表并使用 VBA 创建重复项？

【中文标题】如何将行从一个 Excel 工作表复制到另一个工作表并使用 VBA 创建重复项？

【英文标题】：How can I copy rows from one Excel sheet to another and create duplicates using VBA?

【发布时间】：2012-10-01 23:37:03

【问题描述】：

我有一个包含两张工作表的 Excel 工作簿：sheet1 在 A 到 R 列中有一个大数据表，在第 1 行有标题。Sheet2 在 A 到 AO 列中有数据。

使用 VBA 我试图从 sheet1 复制行并将它们粘贴到 sheet2 的末尾。此外，我只需要将 A 列复制到 R，而不是整行。

换句话说，需要将 sheet1 中的单元格 A2:R2 复制到 A 列中没有数据的第一行和第二行。

我有以下代码从 sheet1 复制所需的单元格，但我不知道如何将每一行复制两次：

Sub example()
    For Each ce In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If Not IsEmpty(ce) Then
            Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 18).Value = Range(ce, ce.Offset(0, 17)).Value
        End If
    Next ce
End Sub

【参考方案1】：

试试这个：

Option Explicit
Sub CopyRows()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim i As Integer, k As Integer
    Dim ws1LR As Long, ws2LR As Long

    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")

    ws1LR = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
    ws2LR = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1

    i = 2
    k = ws2LR
    Do Until i = ws1LR
        With ws1
            .Range(.Cells(i, 1), .Cells(i, 18)).Copy
        End With

        With ws2
            .Cells(k, 1).PasteSpecial
            .Cells(k, 1).Offset(1, 0).PasteSpecial
        End With

        k = k + 2
        i = i + 1
    Loop
End Sub

如果 Sheet1 和 Sheet2 在您的工作簿中被称为不同的东西，请更改它们。

【讨论】：

非常感谢！似乎运行完美，除了它没有复制 sheet1 中的最后一个数据行。知道可能是什么问题吗？

将+1 添加到ws1LR = ... 行的末尾，与ws2LR 行相同。我已经编辑了我的帖子，如果答案对您有用，请点赞和/或接受:)

使用整数存储行号很危险，因为它们可能会溢出。请改用 long。