Public Sub GetDataFiles(strPath$, SheetName$, DataRange$, Col&, Target As Range)
Application.ScreenUpdating = False
On Error Resume Next ''Xu ly loi khi co Sheet Empty
Dim Fso As Object, ObjFile As Object, Sht$, FilePath$
Dim Res(), Arr(), i As Long, j As Long, k As Long, Cols As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
For Each ObjFile In Fso.GetFolder(strPath).Files
If Fso.GetExtensionName(ObjFile) Like "xls*" Then
If Left(ObjFile.Name, 2) <> "~$" Then
If ObjFile.Name <> ThisWorkbook.Name Then
Sht = SheetName & "'!" & DataRange
FilePath = "='" & Fso.GetParentFolderName(ObjFile) _
& "\[" & Fso.GetFilename(ObjFile) & "]" & Sht
With Target.Range(DataRange)
.FormulaArray = FilePath
Res = .Value
Cols = .Columns.Count
.ClearContents
End With
ReDim Preserve Arr(1 To 65536, 1 To Cols)
For i = 1 To UBound(Res)
If Res(i, Col) <> Empty Then
k = k + 1
For j = 1 To UBound(Res, 2)
Arr(k, j) = Res(i, j)
Next
End If
Next
End If
End If
End If
Next
If k Then Target.Resize(k, UBound(Res, 2)).Value = Arr
Set Fso = Nothing
Application.ScreenUpdating = True
End Sub
Chạy sub sau .... còn hàm trên hiểu được đến đâu thì hiểu mà ko hiểu càng khỏe ....
Public Sub Main()
Dim Path As String, Sht As String, Data As String
Path = ThisWorkbook.Path & "\2016"
Sht = "app"
Data = ("B2:L100")
Range("B2:L65536").ClearContents
GetDataFiles Path, Sht, Data, 1, [B2] ''1 = Cot Loc theo dieu kien co du lieu
End Sub
