Split table copy to new workbook

Bl4ckSunr1se

New Member
Joined
Dec 8, 2021
Messages
7
Office Version
  1. 365
Platform
  1. Windows
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
VBA Code:
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

VBA Code:
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
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Hi & welcome to MrExcel.
How about
VBA Code:
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
 
Upvote 0
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
VBA Code:
         newBook.Sheets.Add(, Sheets(newBook.Sheets.Count)).Name = Dic.Keys()(i)
 
Upvote 0
What sort of values do you have in col I?
 
Upvote 0
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
VBA Code:
      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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,952
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top