Các A/C trong nhóm giúp e tách thành nhiều sheet theo file đi kèm này dùm e với ạ.

[vtya]

Sub split()
Dim sh As Worksheet, shnew As Worksheet
Dim rng As Range
Dim c As Range
Dim list As New Collection
Dim item As Variant

Application.ScreenUpdating = fale

Set sh = Worksheets("cn")
Set rng = sh.Range("C2:C" & sh.Range("A" & Rows.Count).End(xlUp).Row)

On Error Resume Next
For Each c In rng
list.Add c.Value, c.Value
Next c
On Error GoTo 0

Set rng = sh.Range("A1:H" & sh.Range("A" & Rows.Count).End(xlUp).Row)

For Each item In list
Set shnew = Worksheets.Add
shnew.Name = item
With rng
.AutoFilter field:=3, Criteria1:=item
.SpecialCells(xlCellTypeVisible).Copy shnew.Range("A1")
.AutoFilter
End With
Next item
sh.Activate
Application.ScreenUpdating = True
End Sub

 

[snow25]

Sub split()
Dim sh As Worksheet, shnew As Worksheet, sh1 As Worksheet
Dim rng As Range
Dim c As Range
Dim list As Object
Dim item As Variant

Application.ScreenUpdating = fale
Application.DisplayAlerts = False
Set list = CreateObject("scripting.dictionary")
Set sh = Worksheets("cn")

Set rng = sh.Range("C2:C" & sh.Range("A" & Rows.Count).End(xlUp).Row)
For Each sh1 In ThisWorkbook.Worksheets
If sh1.Name <> "cn" Then
sh1.Delete
End If
Next
On Error Resume Next
For Each c In rng
If c.Value <> Empty Then list.Add c.Value, c.Value
Next c
On Error GoTo 0

Set rng = sh.Range("A1:j" & sh.Range("A" & Rows.Count).End(xlUp).Row)

For Each item In list
Set shnew = Worksheets.Add
shnew.Name = item
With rng
.AutoFilter field:=3, Criteria1:=item
.SpecialCells(xlCellTypeVisible).Copy shnew.Range("A1")
.AutoFilter
End With
Next item
sh.Activate
Application.ScreenUpdating = True
End Sub
[/CODE]