Split table copy to new workbook

[Bl4ckSunr1se]

Hi,

I'm trying to create multiple tables from one master table. It concerns a training schedule where I want to extract lists per person. So the script should loop through the table and select each person and list their trainings.

I found code on the web, but it doesn't seem to work. I get an error 1004 on

Workbk.Sheets(sht).Range("I1:I" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True

Characters do not exceed 30. The column that needs filtering is "I".

Thanks

Option Explicit

Sub filter()
Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim rng1 As Range
Dim last As Long
Dim sht As String
Dim newBook As Excel.Workbook
Dim Workbk As Excel.Workbook

'Specify sheet name in which the data is stored
sht = "Lijst"

'Workbook where VBA code resides
Set Workbk = ThisWorkbook

'New Workbook
Set newBook = Workbooks.Add(xlWBATWorksheet)
Workbk.Activate

'change filter column in the following code
last = Workbk.Sheets(sht).Cells(Rows.Count, "I").End(xlUp).Row

With Workbk.Sheets(sht)
Set rng = .Range("A1:I" & last)
End With

Workbk.Sheets(sht).Range("I1:I" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True
For Each x In Workbk.Sheets(sht).Range([AA2], Cells(Rows.Count, "AA").End(xlUp))

With rng
.AutoFilter
.AutoFilter Field:=9, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy

newBook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
newBook.Activate
ActiveSheet.Paste
End With
Next x

' Turn off filter
Workbk.Sheets(sht).AutoFilterMode = False

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

End Sub

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub Bl4ckSunr1se()
   Application.ScreenUpdating = False
   Dim Cl As Range
   Dim Dic As Object
   Dim last As Long, i As Long
   Dim newBook As Workbook
   Dim Ws As Worksheet
   
   'Specify sheet name in which the data is stored
   Set Ws = ThisWorkbook.Sheets("Lijst")
   
   'New Workbook
   Set newBook = Workbooks.Add(xlWBATWorksheet)
   Set Dic = CreateObject("scripting.dictionary")
   
   'change filter column in the following code
   last = Ws.Cells(Rows.Count, "I").End(xlUp).Row
   
   For Each Cl In Ws.Range("I1:I" & last)
      Dic(Cl.Value) = Empty
   Next Cl

   For i = 0 To Dic.Count - 1
      With Ws
         .Range("A1:I" & last).AutoFilter 9, Dic.Keys()(i)
         newBook.Sheets.Add(, Sheets(newBook.Sheets.Count)).Name = Dic.Keys()(i)
         .AutoFilter.Range.Copy
         newBook.Sheets(Dic.Keys()(i)).Range ("A1")
      End With
   Next i
   
   ' Turn off filter
   Ws.AutoFilterMode = False
   
   With Application
      .CutCopyMode = False
      .ScreenUpdating = True
   End With

End Sub

 

[Bl4ckSunr1se]

Thx for the help Fluff,
I seem to still be getting an error "1004" (no longer than 30, no specific characters, not empty)
And it marks this line

         newBook.Sheets.Add(, Sheets(newBook.Sheets.Count)).Name = Dic.Keys()(i)

 

[Fluff]

What sort of values do you have in col I?

 

[Bl4ckSunr1se]

Just a bunch of names ... :/

 

[Fluff]

Ok, what is the actual error message that you get?
Also when you get the error, have a look at the main sheet, what is the col I value?
Also realised there is a problem with the code, it should be

      With Ws
         .Range("A1:I" & last).AutoFilter 9, Dic.Keys()(i)
         newBook.Sheets.Add(, Sheets(newBook.Sheets.Count)).Name = Dic.Keys()(i)
         .AutoFilter.Range.Copy newBook.Sheets(Dic.Keys()(i)).Range("A1")
      End With

 

[Bl4ckSunr1se]

I'm getting "Error 1004 during execution: You entered an invalid name. Check the following: the name can't be longer than 31 characters, the name can't contain one of the following: :\/?*[or], the name can't be empty.

I checked whether one of the three error conditions was met, which wasn't the case.

I don't see anything in the main sheet. The Col I value is text.

I replaced the code.

Btw: after executing the code and getting the error message, excel becomes non responsive.

 

[Fluff]

Look at the sheets you are filtering/copying after the error. Col I should show all rows with the same value, what is that value in col I

 

[Bl4ckSunr1se]

So ok, the error occurs, I end the macro and then I'm getting a new excel workbook with two empty worksheets. The original dataset is filtered to "nothing". All lines from the dataset are hidden. It filtered on the header-value.

So now I removed the header and it works. Can we get it to work with the header? And that the headers are being brought over as well?

 

[Bl4ckSunr1se]

So ok, the error occurs, I end the macro and then I'm getting a new excel workbook with two empty worksheets. The original dataset is filtered to "nothing". All lines from the dataset are hidden. It filtered on the header-value.

So now I removed the header and it works. Can we get it to work with the header? And that the headers are being brought over as well?

But now the first line of the dataset is repeated in each separate worksheet