Hi all
I have found below code to split one excel file into multiples:
but I'm getting Runtime Error 1004 AutoFilter method of Rane class failed
my error is in this part of the code:
I have found below code to split one excel file into multiples:
VBA Code:
Option Explicit
Const Target_Folder As String = "C:\Users\nihad.TF\Desktop\split"
Dim wsSource As Worksheet, wsHelper As Worksheet
Dim LastRow As Long, LastColumn As Long
Sub SplitDataset()
Dim collectionUniqueList As Collection
Dim i As Long
Set collectionUniqueList = New Collection
Set wsSource = ThisWorkbook.Worksheets("TransactionList")
Set wsHelper = ThisWorkbook.Worksheets("Helper")
' Clear Helper Worksheet
wsHelper.Cells.ClearContents
With wsSource
.AutoFilterMode = False
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
LastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
If .Range("A2").Value = "" Then
GoTo Cleanup
End If
Call Init_Unique_List_Collection(collectionUniqueList, LastRow)
Application.DisplayAlerts = False
For i = 1 To collectionUniqueList.Count
SplitWorksheet (collectionUniqueList.Item(i))
Next i
ActiveSheet.AutoFilterMode = False
End With
Cleanup:
Application.DisplayAlerts = True
Set collectionUniqueList = Nothing
Set wsSource = Nothing
Set wsHelper = Nothing
End Sub
Private Sub Init_Unique_List_Collection(ByRef col As Collection, ByVal SourceWS_LastRow As Long)
Dim LastRow As Long, RowNumber As Long
' Unique List Column
wsSource.Range("D2:D" & SourceWS_LastRow).Copy wsHelper.Range("A1")
With wsHelper
If Len(Trim(.Range("A1").Value)) > 0 Then
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A1:A" & LastRow).RemoveDuplicates 1, xlNo
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A1:A" & LastRow).Sort .Range("A1"), Header:=xlNo
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
On Error Resume Next
For RowNumber = 1 To LastRow
col.Add .Cells(RowNumber, "A").Value, CStr(.Cells(RowNumber, "A").Value)
Next RowNumber
End If
End With
End Sub
Private Sub SplitWorksheet(ByVal Category_Name As Variant)
Dim wbTarget As Workbook
Set wbTarget = Workbooks.Add
With wsSource
With .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
.AutoFilter .Range("D1").Column, Category_Name
.Copy
'wbTarget.Worksheets(1).PasteSpecial xlValues
wbTarget.Worksheets(1).Paste
wbTarget.Worksheets(1).Name = Category_Name
wbTarget.SaveAs Target_Folder & Category_Name & ".xlsx", 51
wbTarget.Close False
End With
End With
Set wbTarget = Nothing
End Sub
but I'm getting Runtime Error 1004 AutoFilter method of Rane class failed
my error is in this part of the code:
VBA Code:
Private Sub SplitWorksheet(ByVal Category_Name As Variant)
Dim wbTarget As Workbook
Set wbTarget = Workbooks.Add
With wsSource
With .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
.AutoFilter .Range("D1").Column, Category_Name
.Copy
'wbTarget.Worksheets(1).PasteSpecial xlValues
wbTarget.Worksheets(1).Paste
wbTarget.Worksheets(1).Name = Category_Name
wbTarget.SaveAs Target_Folder & Category_Name & ".xlsx", 51
wbTarget.Close False
End With
End With
Set wbTarget = Nothing
End Sub