VBA Excel:Tự động tách dữ liệu và tạo thành nhiều file theo điều kiện

Trong trường hợp, ta có 1 file Excel dữ liệu tổng hợp, muốn tách và tạo ra nhiều file gồm dữ liệu tương ứng theo 1 tiêu chí cụ thể. Ví dụ theo từng đối tác, từng ngày, từng sản phẩm...

Lưu ý: Trong file dữ liệu tổng hợp sẽ gồm 1) Dòng trường dữ liệu (Header) và Phần bên trên - Phần này sẽ có ở tất cả các file được tách và 2) Phần dữ liệu (phần dữ liệu bên dưới Header) - Sẽ được tách dữ liệu. Có 1 Cột chọn làm tiêu chí phân tách, được Sort A to Z.

Lưu ý:
a) iColumn = [n] 'Chon cot can tach': Cột tiêu chí có thứ tự thứ [n] trong trường dữ liệu (Header).
b) iRow = [m] 'Chon dong bat dau tach': Dòng Header có thứ tự thứ [m] từ trên xuống.
c) Chương trình sẽ tạo thư mục có tên Output chứa các file sau khi tách. Có thể đổi tên thư mực Output tại dòng output = "Output" 'Doi ten o day

Sub Tachfile()
Dim iColumn As Integer
      iColumn = 1 'Chon cot can tach'
      iRow = 5 'Chon dong header'
      Dim wb As Workbook
      Dim ThisSheet As Worksheet
      Dim NumOfColumns As Integer
      Dim RangeToCopy As Range
      
      Dim WorkbookCounter As Integer
      Dim Temp As String
     
  
      Application.ScreenUpdating = False


      Set ThisSheet = ThisWorkbook.ActiveSheet
      NumOfColumns = ThisSheet.UsedRange.Columns.Count
      WorkbookCounter = 1
      For p = iRow + 1 To ThisSheet.UsedRange.Rows.Count Step 1
      
      
        
        Dim isExist As Boolean
        isExist = False
        Dim iCount As Integer
        For iCount = 0 To myList.Count - 1 Step 1
            Set strTest = ThisSheet.Cells(p, iColumn)
            If (myList.Item(iCount) = ThisSheet.Cells(p, iColumn)) Then
                isExist = True
                Exit For
            End If
        Next
        
        If (isExist = False) Then
        Set wb = Workbooks.Add
            myListWb.Add wb
            myList.Add ThisSheet.Cells(p, iColumn)
            
            Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(1, 1), ThisSheet.Cells(iRow, NumOfColumns))
            RangeToCopy.Copy wb.Sheets(1).Range("A" & wb.Sheets(1).UsedRange.Rows.Count)
            
            
            Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p, NumOfColumns))
            RangeToCopy.Copy wb.Sheets(1).Range("A" & wb.Sheets(1).UsedRange.Rows.Count + 1)
            
        Else           
            Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p, NumOfColumns))
            RangeToCopy.Copy wb.Sheets(1).Range("A" & wb.Sheets(1).UsedRange.Rows.Count + 1)
            
        End If
        
      Next p
      
      Workbooks.Application.DisplayAlerts = False
      
        
      For p = 0 To myListWb.Count - 1 Step 1
      Set wb = myListWb.Item(p)

        For iColumn = 1 To 45 Step 1
            wb.Worksheets("Sheet1").Columns(iColumn).ColumnWidth = ThisSheet.Columns(iColumn).ColumnWidth
        Next
        
        'wb.SaveAs ThisWorkbook.Path & "\Current\" & myList.Item(p)'
                'Tao thu muc chua cac file da tach, mac dinh "\"'
                
                Set fso = CreateObject("Scripting.FileSystemObject")
                
                ' Tao thu muc Output
                Dim output As String
                output = "Output" 'Doi ten o day
                Dim exist As Boolean
                exist = fso.FolderExists(ThisWorkbook.Path & "\" & output)
                If (exist = False) Then
                   Set f = fso.CreateFolder(ThisWorkbook.Path & "\" & output)
                End If
                
                
                wb.SaveAs ThisWorkbook.Path & "\" & output & "\" & myList.Item(p) & "_" & Format(DateTime.Now, "yyyyMMddhhmm")
        
        wb.Close
      Next
      
      Application.ScreenUpdating = True
      Set wb = Nothing
End Sub

Nếu các bạn có nhu cầu đăng kí khóa học lập trình VBA trong excel hãy Email cho tôi: dinhanhtuan68@gmail.com là một trong những trung tâm uy tín hàng đầu tại Hà Nội với  nhiều năm kinh nghiệm sẽ hướng dẫn từng chi tiết từng buổi học cho các bạn.

Tải file mẫu tại đây

Nếu bạn muốn tạo video chuyên nghiệp và sáng tạo hãy tham gia khóa học HƯỚNG DẪN TỰ TẠO VIDEO CLIP CHUYÊN NGHIỆP SÁNG TẠO

​​​​​

Nhấn vào đây để bắt đầu khóa học ​

Hãy tham gia khóa học để biết mọi thứ

Để tham gia tất cả các bài học, Bạn nhấn vào đây 

Khóa học Phân tích dữ liệu sử dụng Microsoft Power BI

Nhấn vào đây để bắt đầu khóa học

GOOGLE SPREADSHEETS phê không tưởng