Sub Main()
Dim NF As String: NF = "\Phan vung"
Dim Thisbook As Workbook: Set Thisbook = ThisWorkbook
Dim dF As String, cF As String, cp As String
Dim lr As Long, tcp(), rng As Range, i As Integer
Dim sh As Worksheet, dk(), k As Integer, j As Integer
lr = Sheet2.Cells(Rows.Count, "K").End(xlUp).Row
Set rng = Sheet2.Range("J7:J" & lr)
tcp = fRNG(rng)
dF = "CMD /C RD /s /q """ & Thisbook.Path & NF & """"
cF = "CMD /C MD """ & Thisbook.Path & NF & """"
Shell dF, vbHide
Shell cF, vbHide
For i = 0 To UBound(tcp)
cp = "CMD /C COPY """ & Thisbook.FullName & """" & " " & """" & Thisbook.Path & NF & "\" & tcp(i) & Right(Thisbook.Name, 5) & """"
Shell cp, vbHide
Next i
ReDim dk(1 To UBound(tcp) + 2)
dk(UBound(dk) - 1) = "NEW": dk(UBound(dk)) = "="
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 0 To UBound(tcp)
Workbooks.Open Filename:=Thisbook.Path & NF & "\" & tcp(i) & Right(Thisbook.Name, 5) ', ReadOnly:=False
For Each sh In ActiveWorkbook.Sheets
If sh.Name = "Daily Sales by SIP" Then
k = 1
For j = 0 To UBound(tcp)
If tcp(j) <> tcp(i) Then dk(k) = tcp(j): k = k + 1
Next j
sh.Range("$A$6:$AY$" & lr).AutoFilter Field:=10, Criteria1:=dk, Operator:=xlFilterValues
sh.Rows("7:6688").SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
sh.ShowAllData
ActiveWorkbook.Save
End If
Next sh
Workbooks(tcp(i) & Right(Thisbook.Name, 5)).Close
Next i
Call Shell("explorer.exe" & " " & Thisbook.Path & NF, vbNormalFocus)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
'-----------
Function fRNG(rng As Range) As Variant
If rng.Columns.Count > 1 Then Exit Function
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Dim r As Long, Arr()
On Error Resume Next
Arr = rng.Value
For r = 1 To UBound(Arr, 1)
If Arr(r, 1) <> "" And Arr(r, 1) <> "NEW" And Not Dic.Exists(Arr(r, 1)) Then
Dic.Add Arr(r, 1), ""
End If
Next r
fRNG = Dic.Keys
End Function
