Split Excel File

split.bas

Sub TachFileesop()
    Dim Duongdan As String 'Duong dan hien tai
    Dim TargetFilePath As String 'Duong dan file muc tieu
    Dim startIndex As Long ' Diem bat dau chay
    Dim StartIndexTarget As Long 'Diem bat dau chay cua file muc tieu
    Dim PassFile As String 'Pass file neu co
    Dim PassSheet As String 'Pass sheet
    Dim ColumnCheck As String 'Colum se so sanh'
    Duongdan = ThisWorkbook.Path
    ' Input Here
    ' ****************************************************************
    ' ****************************************************************
    ' ****************************************************************
    TargetFilePath = Duongdan & "\DS Phan bo Esop 2021_Tach.xlsx"
    startIndex = 2
    StartIndexTarget = 13
    PassFile = "" 'Neu khong co pass thi de string rong
    PassSheet = "" 'Neu  khong co pass de string rong
    ColumnCheck = "AH" 'Phai de cot chung cho toan bo cac sheet. Neu khong thi hay tao dong cuoi cung
    ' ****************************************************************
    ' ****************************************************************
    ' ****************************************************************


    With ThisWorkbook.Sheets("Sheet1")
        Dim SoDong As Long 'tong so dong
        Dim DuongdanFile As String
        ' Tong so sdong cua file hien tai
        SoDong = .Cells(Rows.Count, 1).End(xlUp).Row

        'START Kiem tra folder output da ton tai hay chua. Chua co thi khoi tao. Mac dinh la output/
        DuongdanFile = ThisWorkbook.Path
        Dim sFolderPath As String, oFSO As Object
        sFolderPath = DuongdanFile & "\output\"
        Set oFSO = CreateObject("Scripting.FileSystemObject") 'Doi tuong oFSO de truy cap den file va folder may tinh
        If oFSO.FolderExists(sFolderPath) = False Then ' kiem tra su ton tai cua forder
             MkDir (DuongdanFile & "\output\") ' MkDir de tao forder co ten TachfileguiBP
        End If
        'END Kiemt ra foldder output

        Dim i As Long 'i la bien chay
        For i = startIndex To SoDong ' Bat dau tu dong so 2 den het (SoDong)
            ' ****************************************************************
            'Doc du lieu dong {i}
            Dim NameFile As String 'Ten file
            Dim key As String 'Ten BP
            Dim wb As Workbook 'Workbook muc tieu
            Dim wbi As Workbook 'File con moi (file tach con tuong ung voi dong {i}
            NameFile = .Cells(i, 2).Value 'Lay gia tri ten file
            key = LCase(.Cells(i, 1).Value) 'Lay gia tri ten phong

            ' ****************************************************************
            ' 1. START: KIEM TRA VA MO FILE MUC TIEU
            'Kiem tra file goc chua du lieu da open hay chua, neu da open thi bo qua, neu chua open thi thuc hien open wb
            'If wb Is Nothing Then
            Set wb = Workbooks.Open(FileName:=TargetFilePath, Password:=PassFile)
            'End If
            ' 1. END: KIEM TRA VA MO FILE MUC TIEU
            ' ****************************************************************



            ' ****************************************************************
            ' 2. START: THUC HIEN SAVEAS NEW FILE
            ' Neu file tach da co, no se xoa va tao file moi
            'Kiem tra file da ton tai trong foder TachfileguiBP chua
            Dim oFiles As Object
            Set oFiles = oFSO.GetFolder(sFolderPath).Files
            For Each oFile In oFiles ' xet vong lap, voi moi file trong all files o foder se chay kiem tra name tung file 1 den luc nao kiem tra het
                Dim fileCheck As String

                fileCheck = oFile.Name ' lay ten file name trong forder, file se chua duoi .xlsx => can loai bo duoi nay de cung gia tri voi Filename o list danh sach
                fileCheck = Left(fileCheck, InStr(fileCheck, ".") - 1) 'dung ham left de lay chuoi gia tri khong chua duoi extention, ham InStr dem do dai cua chuoi den dau "."
                '-tinh ca dau cham => tru di 1 de khong lay dau "." trong gia tri cua chuoi can tim
                If fileCheck = NameFile Then ' xet dieu kien neu gia tri fileCheck o tren = NameFile trong list danh sach thi thuc hien lenh delete file hien tai, neu khong co thi ket thuc
                    oFile.Delete
                End If
            Next
            ' ****************

           'ativate file du lieu goc de save as ra 1 file moi voi namefile la ten  bo phan o file tach file bp
            With wb
                ' Luu workbook hien tai thanh file moi
                .SaveAs FileName:=sFolderPath & NameFile & ".xlsx", FileFormat:=51 '51 la dinh dang Excel 2007 tro len
            End With
                'Active File moi duoc save as ra
            '.Close SaveChanges:=False
            Workbooks(NameFile & ".xlsx").Activate
            Set wbi = Workbooks.Open(FileName:=sFolderPath & NameFile & ".xlsx")
            ' 2. END: THUC HIEN SAVEAS NEW FILE
            ' ****************************************************************



            ' ****************************************************************
            ' 3. START: XOA DU LIEU KHONG PHU HOP
            'Active sheet "Nam 2021 - Ca nhan" cua file
            With wbi
                Dim ws As Worksheet
                For Each ws In wbi.Sheets
                    Application.DisplayAlerts = False
                    If ws.Visible = xlSheetVisible Then
                        ws.Activate
                        ws.Unprotect Password:=PassSheet ' mo pass cua sheet

                        With ws
                            Dim lastRow As Long 'Bien nay luu tong so dong cua file sheet
                            Dim needDelete As Boolean
                            needDelete = True
                            lastRow = .Cells(Rows.Count, 2).End(xlUp).Row 'Gan gia tri cho lastRow
                            Dim j As Long 'j la bien chay cua file goc
                            j = StartIndexTarget

                            While j < lastRow
                                Dim key2 As String

                                If Not IsError(.Range(ColumnCheck & j).Value) Then
                                    key2 = LCase(.Range(ColumnCheck & j).Value)

                                Else
                                    Debug.Print "Loi du lieu"
                                    key2 = "" ' Gán giá tr? m?c d?nh n?u ô ch?a l?i
                                End If ' lay gia tri AH - tuc la ten phong

                                If key <> key2 And key2 <> "" Then
                                    'Debug.Print "DELETE: " & key2
                                    Range(j & ":" & j).EntireRow.Delete
                                    j = j - 1 'Vi xoa 1 dong, nen bien chay se lui lai 1 dong
                                    'lastRow = lastRow - 1 'Vi xoa 1 dong, nen total dong cung se giam di 1
                                Else
                                    If key2 <> "" Then
                                        needDelete = False
                                    End If

                                    'Debug.Print key2
                                End If
                                j = j + 1 'Sau khi xu ly xong dong nay, thi tang J nen 1 de chay dong tiep theo

                            Wend 'Ket thuc vong lap while

                        'If .Range("AH14").Value = "" Then
                            ' Worksheets(nameSheet).Visible = False
                        'End If
                        'Worksheets(nameSheet).Columns("AH:AH").Hidden = True 'ket thuc vong lap while - wend thi thuc hien xoa 2 cot AN- AO
                        ws.Protect Password:=PassSheet ' protect sheet lai, ket thuc thao tac voi sheet nay
                        If needDelete = True Then
                            ws.Delete
                        End If

                        wbi.Save
                        End With
                    End If
                    Application.DisplayAlerts = True
                Next ws
                wbi.Close SaveChanges:=True

            End With
             ' hoan tat xong thi save file va close
            '3. END: XOA DU LIEU KHONG PHU HOP
            ' ****************************************************************

        Next i ' chay tiep i  tuc la chay tiep file bo phan khac
    End With
        MsgBox "All files Split successfully!", _
        vbInformation, "All files Splited"
    
End Sub
' ****************************************************************

Tách esope