使用For Loop批量创建指定名称Worksheet并填充指定单元格

嘿，这就给你搞定这段代码，完全匹配你的需求——可以接收自定义的名称列表，在当前活动工作表的后面批量创建对应名称的工作表，还能给每个新表的A1单元格填上指定内容。

基础版代码（直接定义列表） #

这段代码里你可以直接在数组里写好要创建的工作表名称和对应的A1内容，运行就能生成：

Sub CreateWorksheetsWithContent()
    ' 定义要创建的工作表名称列表，以及对应的A1单元格填充内容
    Dim sheetNames As Variant
    Dim cellContents As Variant
    sheetNames = Array("This is Metric1", "This is Metric2")
    cellContents = Array("testing1", "testing2")
    
    Dim i As Integer
    Dim newSheet As Worksheet
    
    ' 循环处理每个列表项
    For i = LBound(sheetNames) To UBound(sheetNames)
        ' 在当前活动工作表的后方创建新表
        Set newSheet = ThisWorkbook.Sheets.Add(After:=ActiveSheet)
        
        ' 给新工作表设置名称
        newSheet.Name = sheetNames(i)
        
        ' 填充A1单元格
        newSheet.Range("A1").Value = cellContents(i)
    Next i
End Sub

关键逻辑说明 #

• sheetNames和cellContents两个数组是配对的，你可以随意添加更多元素，比如要创建5个表就往数组里加5组对应的值就行。
• Sheets.Add(After:=ActiveSheet)这个参数很重要，它保证新表总是出现在你当前选中的工作表后面，不管这个活动表叫什么名字。
• 整个循环逻辑简单直接，依次完成创建表、重命名、填充内容三个步骤，不容易出错。

进阶版（从单元格读取列表） #

如果不想每次改代码，想直接在Excel里维护名称和内容列表，可以用这个版本——假设你把工作表名称写在当前活动表的A列，对应的A1内容写在B列：

Sub CreateSheetsFromCellRange()
    ' 读取当前活动表A列的名称列表（从A1开始到最后一行有内容的单元格）
    Dim nameListRange As Range
    Set nameListRange = ActiveSheet.Range("A1:A" & ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row)
    
    Dim listCell As Range
    Dim newSheet As Worksheet
    
    ' 遍历每个列表项
    For Each listCell In nameListRange
        ' 创建新表到活动表后方
        Set newSheet = ThisWorkbook.Sheets.Add(After:=ActiveSheet)
        ' 用A列的内容给新表命名
        newSheet.Name = listCell.Value
        ' 用B列对应单元格的内容填充新表A1
        newSheet.Range("A1").Value = listCell.Offset(0, 1).Value
    Next listCell
End Sub

这个版本更灵活，适合需要频繁调整列表内容的场景。

内容的提问来源于stack exchange，提问作者Matt G