Chia 1 sheet thành nhiều sheet con (2 người xem)

[rosy84]

Em có đính kèm 1 file mong các bác giúp đỡ.

 

[sealand]

Bạn tham khảo nhé:

Sub chep()
Dim chuoi
Application.ScreenUpdating = False
With Sheet1
For i = 18 To 56536
If .Cells(i, 1) = "" Then Exit For
If InStr(1, chuoi, .Cells(i, 1)) = 0 Then
chuoi = chuoi & .Cells(i, 1) & ";"
xoa_sh .Cells(i, 1)
Set new_sh = Sheets.Add
new_sh.Name = .Cells(i, 1)
Copy_data .Cells(i, 1)
End If
Next
End With
Application.ScreenUpdating = True
Sheet1.Select
End Sub
'----------------------------------------------------------
Sub xoa_sh(ByVal sh_name As String)
Application.DisplayAlerts = False
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets
If sh.Name = sh_name Then sh.Delete
Next
Application.DisplayAlerts = True
End Sub
'----------------------------------------------------------
Sub Copy_data(ByVal Ma As String)
    Dim Rng As Range
    With Sheet1
    .Rows("11:2000").AutoFilter Field:=1, Criteria1:=Ma
        Set Rng = .AutoFilter.Range.Offset(1, 0).Resize(.AutoFilter.Range.Rows. _
                   Count - 1).SpecialCells(xlCellTypeVisible)
        Rng.Copy Destination:=Sheets(Ma).Range("A1")
        .Rows("11:2000").AutoFilter
    End With
End Sub

Trong bài có sử dụng code của bác Sa_DQ, nhớ Thank bác Sa_DQ giùm.