0
我使用此代码(来自Splitting worksheet into multiple workbooks),并且代码在第3列中使用简短数据库进行过滤时运行良好。但是,我有一个数据库其中要用作过滤器的列,也称为字段,位于35列或“AI”中,并且在这种情况下代码不起作用。所以,这段代码只是根据已过滤列的值(好)创建工作簿,但数据本身未被过滤,从而创建(在本例中)三个相同的文件。有什么建议么?这是我使用的代码:将excel工作表中的数据拆分为基于列值的多个工作簿
Sub CreateBatchWorkbooks()
On Error Resume Next
Application.DisplayAlerts = False
With ThisWorkbook.Sheets("CalcData") 'Replace the sheet name with the raw data sheet name
Set Newsheet = ThisWorkbook.Sheets("cal")
If Newsheet Is Nothing Then
Worksheets.Add.Name = "cal"
Else
ThisWorkbook.Sheets("cal").Delete
Worksheets.Add.Name = "cal"
End If
FilterField = WorksheetFunction.Match("BatchNumber()", ThisWorkbook.Sheets("CalcData").Range("1:1"), 0)
.Columns(FilterField).Copy
With ThisWorkbook.Sheets("cal")
.Range("a1").PasteSpecial (xlPasteAll)
.Columns("a").RemoveDuplicates Columns:=1, Header:=xlYes
End With
For Each cell In ThisWorkbook.Sheets("cal").Columns("a").Cells
i = i + 1
If i <> 1 And cell.Value <> "" Then
.AutoFilterMode = False
.Rows(1).AutoFilter field:=FilterField, Criteria1:=cell.Value
Set new_book = Workbooks.Add
.UsedRange.Copy
new_book.Sheets(1).Range("a1").PasteSpecial (xlPasteAll)
new_book.SaveAs Filename:=ThisWorkbook.Path & "\" & cell.Value & ".xlsx"
new_book.Sheets(1).UsedRange.Columns.AutoFit
new_book.Save
new_book.Close
End If
Next cell
ThisWorkbook.Sheets("cal").Delete
End With
End Sub
在此先感谢!
摆脱'On Error Resume Next'(参见[Documentation](https://stackoverflow.com/documentation/) VBA/3211 /错误处理/ 11022 /恢复关键字))。由于这一行,您在代码中遇到的任何错误都被完全忽略。回报任何错误消息(编辑您的帖子以包含它们)。然后阅读有关错误处理的文档部分的其余部分。没有任何理由可以使用OERN。 – FreeMan
此外,您正尝试在一列范围上过滤字段#35。您链接到的上一篇文章在评论中显示了此更正。 –
我刚更新了代码。仍然没有任何东西正在解决有什么建议么? – dmalvareg