Experts,
The following code uses filters to copy like sets of data to their own sheets within a workbook. This works fantastic if the data results in say less than 100 sheets being created. Anything beyond that and the macro never finishes (well I have let it run for up to 1 hour before giving up). My dataset has suddenly quadrupled and I have a need to create up to 500 sheets in a single workbook. 1) is that even possible? 2) how can my code be tweaked to handle this?
Thanks!
The following code uses filters to copy like sets of data to their own sheets within a workbook. This works fantastic if the data results in say less than 100 sheets being created. Anything beyond that and the macro never finishes (well I have let it run for up to 1 hour before giving up). My dataset has suddenly quadrupled and I have a need to create up to 500 sheets in a single workbook. 1) is that even possible? 2) how can my code be tweaked to handle this?
Thanks!
Code:
Sub DataCopyToOwnSheetUsingFilters()
Dim v As String
Dim i As Integer
Application.ScreenUpdating = False 'speeds up the process by not refreshing the screen
Sheets("Copy From").Activate
Range("A:A").Copy
Range("W1").PasteSpecial (xlPasteAll)
Range("W1").RemoveDuplicates 1, xlYes
For i = 2 To Range("W600").End(xlUp).Row 'change "2000" to a number that allows for a cushion
v = Cells.Range("W" & i)
Range("a1").AutoFilter 1, Range("W" & i)
Range("a1").CurrentRegion.Copy
On Error GoTo ErrMsg
Sheets.Add.Name = (v)
ActiveCell.PasteSpecial (xlPasteAll)
Sheets(v).Columns("A:U").EntireColumn.AutoFit
Sheets("Copy From").Activate
Range("a1").AutoFilter
Next i
Range("W:W").Delete
Application.ScreenUpdating = True 'turns refreshing back on
Exit Sub
ErrMsg:
Application.DisplayAlerts = False
Sheets(ActiveSheet.Name).Delete
Application.DisplayAlerts = True
Sheets("Copy From").Activate
Range("a1").AutoFilter
Range("W:W").Delete
MsgBox ("That sheet, " & v & ", already exists. Please start over with a clean workbook."), , "OOPS, USER ERROR!"
End Sub