MS Excel VBA将多张图纸拆分为多个文件

我正在尝试将1个excel文件中的多个工作表[3]拆分为更小的文件，每个文件都有相同的3个工作表，但每个文件的部分更小，并按其中1列中的值拆分[所有3个工作表上都有相同的筛选列标题，但其余数据不同]

我可以用一张纸来完成这项工作，这会为一张纸生成许多不同的文件，但我基本上无法将相同的自动过滤器应用到其他两张纸上，而不会失败。我对数组不太了解

下面是代码，直到它中断。请注意，第一个表是Query1，第二个表是Query2，导出条件是工作簿范围内的命名范围

Dim ArrayItem As Long
Dim ws As Worksheet
Dim ArrayOfUniqueValues As Variant
Dim SavePath As String
Dim ColumnHeadingInt As Long
Dim ColumnHeadingStr As String
Dim rng As Range
Dim MainWkbk As Workbook
Dim NextWkbk As Workbook
Dim CustomerLevelRange As Range
Dim tbl As ListObject
Dim Pt As PivotTable
Dim CurrentFilter

Set MainWkbk = ActiveWorkbook
Set ws = Sheets("Customer_Level_Detailed")
SavePath = "D:\test\"
ColumnHeadingInt = WorksheetFunction.Match(Range("ExportCriteria").Value, Range("Query1[#Headers]"), 0)
ColumnHeadingStr = "Query1[[#All],[" & Range("ExportCriteria").Value & "]]"

Application.ScreenUpdating = False
Range(ColumnHeadingStr & "").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("UniqueValues"), Unique:=True

ws.Range("UniqueValues").EntireColumn.Sort Key1:=ws.Range("UniqueValues").Offset(1, 0), _
Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(ws.Range("UniqueValues").EntireColumn.SpecialCells(xlCellTypeConstants))

ws.Range("UniqueValues").EntireColumn.Clear

For ArrayItem = 2 To UBound(ArrayOfUniqueValues)

Workbooks.Add
Set NextWkbk = ActiveWorkbook
ActiveSheet.Name = "Customer_Level_Detailed"

Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Service_Level_Detailed"

'CUSTOMER_LEVEL_PASTE
MainWkbk.Activate
Sheets("Customer_Level_Detailed").Select
ws.ListObjects("Query1").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
ws.Range("Query1[#All]").SpecialCells(xlCellTypeVisible).Copy
NextWkbk.Activate
Sheets("Customer_Level_Detailed").Select
Range("A3").PasteSpecial xlPasteAll
Set CustomerLevelRange = Range(Range("A3"), Range("A3").SpecialCells(xlLastCell))
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, CustomerLevelRange, , xlYes)
tbl.TableStyle = "TableStyleMedium15"

'SERVICE LEVEL PASTE
MainWkbk.Activate
Sheets("Service_Level_Detailed").Select
ColumnHeadingInt = WorksheetFunction.Match(Range("ExportCriteria").Value, Range("Query2[#Headers]"), 0)
ws.ListObjects("Query2").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
' ^^ THIS IS THE POINT THE FAILURE OCCURS ^^
ws.Range("Query2[#All]").SpecialCells(xlCellTypeVisible).Copy

Next ArrayItem

ws.AutoFilterMode = False
MsgBox "Finished exporting!"
Application.ScreenUpdating = True

---

这是因为您使用

ws

（定义为

工作表（“客户级别详细”）

）作为

Query2

表的明确工作表限定，而该表位于

服务级别详细的
工作表中

这比之前选择了想要的工作表更有效（
Sheets（“Service\u Level\u Detailed”）。选择
）

因此，一个快速而肮脏的修复方法是将所有出现的
ws
事件更改为
ActiveSheet
事件。例如：

ws.ListObjects("Query2").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)

致：


更可靠的解决方案是定义一个合适的工作表变量并使用它

Dim serviceWs As Worksheet
Set serviceWs = Sheets("Service_Level_Detailed")

...
MainWkbk.Activate
serviceWs.Select
ColumnHeadingInt = WorksheetFunction.Match(Range("ExportCriteria").Value, Range("Query2[#Headers]"), 0)
serviceWs.ListObjects("Query2").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
serviceWs.Range("Query2[#All]").SpecialCells(xlCellTypeVisible).Copy


但最佳做法是避免任何选择/选择模式，并使用完全限定的范围对象：

    With MainWkbk.Sheets("Service_Level_Detailed") ' reference wanted sheet in wanted workbook
        ColumnHeadingInt = WorksheetFunction.Match(.Range("ExportCriteria").Value, .Range("Query2[#Headers]"), 0) ' use 'dot' to access referenced object (sheet, in this case) members (ranges, in this case)
        .ListObjects("Query2").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
        .Range("Query2[#All]").SpecialCells(xlCellTypeVisible).Copy
    End With

这是因为您使用
ws
（定义为
工作表（“客户级别详细”）
）作为
Query2
表的明确工作表限定，而该表位于
服务级别详细的
工作表中

这比之前选择了想要的工作表更有效（
Sheets（“Service\u Level\u Detailed”）。选择
）

因此，一个快速而肮脏的修复方法是将所有出现的
ws
事件更改为
ActiveSheet
事件。例如：

ws.ListObjects("Query2").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)

致：


更可靠的解决方案是定义一个合适的工作表变量并使用它

Dim serviceWs As Worksheet
Set serviceWs = Sheets("Service_Level_Detailed")

...
MainWkbk.Activate
serviceWs.Select
ColumnHeadingInt = WorksheetFunction.Match(Range("ExportCriteria").Value, Range("Query2[#Headers]"), 0)
serviceWs.ListObjects("Query2").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
serviceWs.Range("Query2[#All]").SpecialCells(xlCellTypeVisible).Copy


但最佳做法是避免任何选择/选择模式，并使用完全限定的范围对象：

    With MainWkbk.Sheets("Service_Level_Detailed") ' reference wanted sheet in wanted workbook
        ColumnHeadingInt = WorksheetFunction.Match(.Range("ExportCriteria").Value, .Range("Query2[#Headers]"), 0) ' use 'dot' to access referenced object (sheet, in this case) members (ranges, in this case)
        .ListObjects("Query2").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
        .Range("Query2[#All]").SpecialCells(xlCellTypeVisible).Copy
    End With

很高兴帮助你很高兴帮助你