Sub run()
' TatChop
Dim ArrID, ArrFileDuLieu, ArrFileOpen
Dim RangeID As Range
Dim i&, j&, SoCotGoc&
Dim wb As Workbook
Dim KQwb As Workbook
Set KQwb = ThisWorkbook
On Error GoTo Thoat
ArrFileDuLieu = Application.GetOpenFilename(FileFilter:="(*.xlsx), *.xlsx", Title:="Chon File", MultiSelect:=True)
For i = 1 To UBound(ArrFileDuLieu)
Workbooks.Open ArrFileDuLieu(i)
Next
ReDim ArrFileOpen(UBound(ArrFileDuLieu))
For Each wb In Application.Workbooks
If wb.Name <> "PERSONAL.XLSB" And wb.Name <> KQwb.Name Then
j = j + 1
ArrFileOpen(j) = wb.Name
End If
Next
For i = 1 To UBound(ArrFileOpen)
SoCotGoc = (i - 1) * 7 + 1
With Workbooks(ArrFileOpen(i))
Set RangeID = .Sheets("Sheet1").Range("B2:B" & .Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row)
ListID = XoaTrungArrCot(RangeID)
For j = 0 To UBound(ListID)
If i = 1 Then
KQwb.Sheets.Add.Name = ListID(j)
End If
Set RangeFilterByID = .Sheets("Sheet1").[A1].CurrentRegion
RangeFilterByID.AutoFilter Field:=2, Criteria1:=ListID(j)
RangeFilterByID.SpecialCells(xlCellTypeVisible).Copy
KQwb.Sheets("" & ListID(j)).Cells(1, SoCotGoc).PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
ActiveSheet.AutoFilterMode = False
Next
.Close SaveChanges:=False
End With
Next
For Each sh In KQwb.Worksheets
sh.UsedRange.Columns.AutoFit
sh.Name = "ID " & sh.Name
Next
Thoat:
' BatChop
End Sub
Public Function XoaTrungArrCot(Vung As Range) As Variant()
On Error Resume Next
Dim ArrCot
Dim i
Dim Dict As Object
Set Dict = CreateObject("Scripting.Dictionary")
ArrCot = Vung.Value
'ReDim ArrCot(UBound(ArrCot))
For i = LBound(ArrCot, 1) To UBound(ArrCot, 1)
Dict.Add ArrCot(i, 1), i
' Debug.Print ArrCot(i, 1), Dict(ArrCot(i, 1))
'Tiep:
Next
' ReDim ArrRes(Dict.Count - 1)
' For j = 0 To Dict.Count - 1
' ArrRes(j) = Dict.keys(i)
'Next
XoaTrungArrCot = Dict.keys
End Function
Public Sub TatChop()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
End Sub
Public Sub BatChop()
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
