I am attempting to split multiple sheets [3] from 1 excel file into smaller files with the same 3 sheets, but smaller sections of each file, which is split by a value in 1 of the columns [same column heading that is being filtered is on all 3 sheets, but the rest of the data is different]
i am am able to do this with 1 sheet, which generates many different files for 1 sheet, but i am stuck basically applying the same auto filter to the other 2 sheets without it failing. i dont know too much about arrays
Below is the code until it breaks. note that the 1st table is Query1, and the 2nd is Query2, Export Criteria is a workbook scoped named range
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 
