基于唯一值创build工作表

我有一个数据集sortingdate明智的，我想复制数据基于月份，即每个月的数据将被复制到一个新的工作表，并且工作表的名称将是当前月的名称。 数据集： http ： //bit.ly/1CoHV5j

我试着运行下面的代码：

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 

但是这个错误不断出现：

“您为表格或图表input了一个无效的名称，请确保：您input的名称不超过31个字符名称不包含任何以下字符：\ /？* [或]您不要将名称留空

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

Answer 1

在一些单元格中的文本可能有保留的字符…你可以尝试下面，用清理的stringreplacesheeets.add位

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