Vba 基于唯一值创建工作表

我有一个按日期排序的数据集，我希望根据月份复制数据，即每个月的数据复制到新工作表中，工作表的名称将是当前月份的名称。 数据集：

我尝试运行以下代码：

Sub x()
Dim rng As Range

With ActiveSheet
    .AutoFilterMode = False
    Sheets.Add().Name = "Temp"
    .Range("H2", .Range("H2").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("A1"), Unique:=True

    For Each rng In Sheets("Temp").UsedRange.Offset(1).Resize(Sheets("Temp").UsedRange.Rows.Count - 1)
        .Range("A1").CurrentRegion.AutoFilter field:=8, Criteria1:=rng
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = rng.Text
        .AutoFilter.Range.Copy Sheets(rng).Range("A1")

    Next rng

    .AutoFilterMode = False
    Application.DisplayAlerts = False
    Sheets("Temp").Delete
    Application.DisplayAlerts = True

End With

End Sub

但这个错误不断出现：

“为工作表或图表键入的名称无效。请确保： 键入的名称不超过31个字符 该名称不包含以下任何字符：\/？*[或] 您不能将名称留空

---

请帮助并告诉我哪里出了问题。

某些单元格中的文本可能有保留字符…您能否尝试以下操作，替换sheeets。使用清理过的字符串添加位

PS：您还应该确保用作名称的单元格不为空

完整的代码应该如下所示

Sub x()
    Dim rng As Range
    Dim SheeetName as string    
    With ActiveSheet
    .AutoFilterMode = False
    Sheets.Add().Name = "Temp"
    .Range("H2", .Range("H2").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("A1"), Unique:=True
    For Each rng In Sheets("Temp").UsedRange.Offset(1).Resize(Sheets("Temp").UsedRange.Rows.Count - 1)
        .Range("A1").CurrentRegion.AutoFilter field:=8, Criteria1:=rng
        SheeetName = GetGoodSheetName(rng.Text)
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = SheeetName
        .AutoFilter.Range.Copy Sheets(SheetName).Range("A1")

    Next rng

    .AutoFilterMode = False
    Application.DisplayAlerts = False
    Sheets("Temp").Delete
    Application.DisplayAlerts = True
    End With
End Sub

Function GetGoodSheetName(fromName As String) As String
    Dim objRegex As Object
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .Global = True
        .Pattern = "[\<\>\*\\\/\?|]"
        GetGoodSheetName = .Replace(fromName, "_")
    End With
End Function

subx（）
变暗rng As范围
Dim SheeetName作为字符串
使用ActiveSheet
.AutoFilterMode=False
Sheets.Add（）.Name=“Temp”
.Range（“H2”），.Range（“H2”）.End（xlDown））.AdvancedFilterAction:=xlFilterCopy，CopyToRange:=Sheets（“Temp”）.Range（“A1”），Unique:=True
对于图纸中的每个rng（“临时”）.UsedRange.Offset（1）。调整大小（图纸（“临时”）.UsedRange.Rows.Count-1）
.Range（“A1”）.CurrentRegion.AutoFilter字段：=8，Criteria1:=rng
SheeetName=GetGoodSheetName（rng.Text）
Sheets.Add（之后：=Sheets（Sheets.Count））.Name=SheeetName
.AutoFilter.Range.Copy图纸（SheetName）.Range（“A1”）
下一个rng
.AutoFilterMode=False
Application.DisplayAlerts=False
工作表（“临时”）。删除
Application.DisplayAlerts=True
以
端接头
函数GetGoodSheetName（fromName作为字符串）作为字符串
作为对象的Dim objRegex
设置objRegex=CreateObject（“vbscript.regexp”）
用objRegex
.Global=True
.Pattern=“[\\*\\\\/\？\124;]”
GetGoodSheetName=.Replace（fromName，“\”）
以
端函数

谢谢您的回复。您能更清楚地说明在哪里包含此功能吗？我有点不知道删除和添加什么以及最终代码的外观。请参见上面的编辑。现在这一行显示下标超出范围错误：.AutoFilter.range.Copy Sheets（rng）.range（“A1”）。但是，当我在这一行中将rng更改为rng.text时，它会说不能将一张工作表重命名为与另一张工作表相同的名称。我不知道哪里出了问题。请尝试更新代码-您需要在每个使用位置更改工作表名称，以使其一致。您用于工作表名称的单元格是否也非空？如屏幕所示t:。我的最终目标是在不同的表中按月份分隔数据，这些表的名称将与它们将包含的月份的数据相同。因此，它从“H”列中查找唯一的月份，并使用它们重命名这些表