[SIZE=3][FONT=Times New Roman]Public Sub Vidu()
Dim cel As Variant
Dim w As Variant
Dim NumEntry As Integer
Dim SourceWb As Workbook
Dim TgtWb As Workbook
Dim NumSht As Integer
Dim wPath As String
Dim nName As String
Dim MyRange As New Collection
Dim ICount As Variant[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]Set SourceWb = ThisWorkbook
wPath = ThisWorkbook.Path
On Error Resume Next
With Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)) 'Du lieu o cot A
.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
End With
NumEntry = WorksheetFunction.Subtotal(3, Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)))
Range("A1").Select
For ICount = 1 To NumEntry[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman] For Each w In Worksheets
If ActiveCell(ICount + 1, 1) = w.Name Then
MyRange.Add ActiveCell(ICount + 1, 1)
End If
Next w
Next ICount
ActiveSheet.ShowAllData
Workbooks.Add
Set TgtWb = ActiveWorkbook
NumSht = Sheets.Count
For Each cel In MyRange
SourceWb.Activate
Sheets(cel.Value).Move After:=TgtWb.Sheets(TgtWb.Sheets.Count)
Next
TgtWb.Activate
Application.DisplayAlerts = False
For cel = 3 To 1 Step -1
Sheets(cel).Delete
Next
nName = wPath & "\" & Left(SourceWb.Name, 7) & "-SoChiTiet" & ".xls"
ActiveWorkbook.SaveAs Filename:=nName
Application.DisplayAlerts = True
ActiveWindow.Close
End Sub[/FONT][/SIZE]
