自动生成excle多个sheet页

L.傲骨雄风

于 2025-05-15 14:52:39 发布

阅读量962

点赞数 7

CC 4.0 BY-SA版权

文章标签： office操作 excel操作

本文链接：https://blog.csdn.net/xlp789/article/details/147983277

效果示例：

原始数据（A列）：

A1: 北京
A2: 上海
A3: 广州
A4: 深圳
A5: 重庆

运行宏后将生成名为“北京”、“上海”、“广州”、“深圳”、“重庆”的5个新工作表。

你可以使用Excel的VBA宏来自动创建以指定列内容命名的工作表。以下是详细步骤：

步骤说明：

准备数据
在Excel的某一列（例如A列）中输入需要生成工作表名称的中文内容（如A1:A5分别输入a、b、c、d、e）。
打开VBA编辑器
按下 Alt + F11 打开VBA编辑器。
插入新模块
在左侧“工程资源管理器”中右键点击你的工作簿名称，选择 插入 > 模块。
粘贴以下代码到模块中
此代码会自动读取A列内容并生成对应名称的工作表：

Sub CreateSheetsFromColumn()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim cell As Range
    Dim sheetNamesRng As Range
    Dim sheetName As String
    
    ' 设置数据源（假设名称在Sheet1的A列）
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set sheetNamesRng = sourceSheet.Range("A1:A" & sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row)
    
    ' 遍历每个单元格
    For Each cell In sheetNamesRng
        sheetName = Trim(cell.Value)
        
        ' 跳过空单元格
        If sheetName = "" Then GoTo Continue
        
        ' 检查名称是否有效（避免重复和非法字符）
        If Not IsValidSheetName(sheetName) Then
            MsgBox "跳过无效名称: " & sheetName, vbExclamation
            GoTo Continue
        End If
        
        ' 创建新工作表
        Set targetSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        On Error Resume Next  ' 尝试重命名，处理可能的错误
        targetSheet.Name = sheetName
        If Err.Number <> 0 Then
            MsgBox "工作表 """ & sheetName & """ 已存在或名称无效，已跳过。", vbExclamation
            Err.Clear
            Application.DisplayAlerts = False
            targetSheet.Delete  ' 删除无法命名的Sheet
            Application.DisplayAlerts = True
        End If
        On Error GoTo 0
Continue:
    Next cell
    
    MsgBox "工作表已生成完成！", vbInformation
End Sub

Function IsValidSheetName(sheetName As String) As Boolean
    ' 检查名称是否合法（不能包含 \ / ? * [ ] 等字符，且长度<=31）
    If sheetName Like "*[\\/?*[\]]*" Or Len(sheetName) > 31 Then
        IsValidSheetName = False
    Else
        IsValidSheetName = True
    End If
End Function

运行宏