我有一个按日期排序的数据集,我想根据月份复制数据,即每个月要复制到新工作表的数据,工作表的名称将是当月的名称。 数据集: 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
但是这个错误不断出现:
"您为工作表或图表键入了无效的名称。确保: 您键入的名称不超过31个字符 该名称不包含以下任何字符:\ /? * [ 要么 ] 您不要将名称留空
请帮助并告诉我哪里出错了。
答案 0 :(得分:1)
某些单元格中的文本可能有保留字符...您可以尝试以下操作,用清理后的字符串替换sheeets.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