VBA filter cột chỉ định và xuất file SCV cùng thư mục

 

Sub ExportFilteredDataToCSV()

    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