The Scenario: You have a massive dataset with a specific category column (e.g., Store Name, Employee ID, or Province). Your task is to split this master table into smaller parts, where each unique category is saved as a separate CSV file in your local folder.
What this code solves:
•Automatic unique list discovery: It automatically scans Column C to identify how many unique entities need to be exported—no manual input required.
•Filename sanitization: It automatically replaces "forbidden" Windows characters (such as / \ : ? *) with underscores to prevent crashes or errors during the saving process.
Dim ws As Worksheet
Dim newWorkbook As Workbook
Dim rng As Range
Dim cell As Range
Dim filterValues As Variant
Dim i As Long
Set ws = ActiveWorkbook.ActiveSheet
Set rng = ws.Range("C1:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)
filterValues = WorksheetFunction.Unique(rng)
i = UBound(filterValues, 1)
For i = 1 To i
filterValue = filterValues(i, 1)
rng.AutoFilter Field:=1, Criteria1:=filterValue
If WorksheetFunction.Subtotal(103, rng) > 1 Then
If filterValue <> ws.Range("C1").Value Then
Dim fileName As String
fileName = filterValue & ".csv"
fileName = Replace(fileName, "/", "_")
fileName = Replace(fileName, "\", "_")
fileName = Replace(fileName, ":", "_")
fileName = Replace(fileName, "?", "_")
fileName = Replace(fileName, "*", "_")
fileName = Replace(fileName, "[", "_")
fileName = Replace(fileName, "]", "_")
Set newWorkbook = Workbooks.Add
With newWorkbook.Sheets(1)
ws.UsedRange.Offset(1).Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues
.Columns.AutoFit
Application.DisplayAlerts = False
.SaveAs fileName:=ThisWorkbook.Path & "\" & fileName, FileFormat:=xlCSV
Application.DisplayAlerts = True
End With
newWorkbook.Close SaveChanges:=False
Set newWorkbook = Nothing
End If
End If
ws.AutoFilterMode = False
Next i
MsgBox "Export to CSV files completed!"
End Sub
Nhận xét
Đăng nhận xét