Dù chưa trọn vẹn lắm nhưng vẫn cám ơn bạn nhiều nhé
Lâu lắm rồi mình ko code két quên hết tiêu....tham khảo code từ GPE quậy một tẹo cho đỡ quên...
Function ListFileName(ByVal strPath As String, sArr())
Dim ObjFile As Object, x As Long
With CreateObject("Scripting.FileSystemObject")
For Each ObjFile In .GetFolder(strPath).Files
If .GetExtensionName(ObjFile) Like "xls*" Then
If Left(ObjFile.Name, 2) <> "~$" Then
If ObjFile.Name <> ThisWorkbook.Name Then
x = x + 1
ReDim Preserve sArr(1 To x)
sArr(x) = ObjFile
End If
End If
End If
Next
End With
End Function
Public Sub TongHopFiles(ByVal sFile As String)
Application.ScreenUpdating = False
Dim x As Long, k As Long, i As Long, j As Long
Dim Kq(1 To 65536, 1 To 100), Arr(), sArr(), Sh As Worksheet
ListFileName sFile, sArr
For x = 1 To UBound(sArr)
With Workbooks.Open(sArr(x))
For Each Sh In .Worksheets
With Sheets("THA")
Arr = Sh.Range("A10", Sh.[A65536].End(3)).Resize(, 100).Value
End With
For i = 1 To UBound(Arr, 1)
If Len(Arr(i, 2)) > 1 Then
k = k + 1
Kq(k, 1) = k
For j = 2 To UBound(Arr, 2)
Kq(k, j) = Arr(i, j)
Next
End If
Next
Next
.Close False
End With
With Sheet1.Range("A10")
.Resize(k * 10, UBound(Arr, 2)).ClearContents
.Resize(k, UBound(Arr, 2)) = Kq
End With
Next
Application.ScreenUpdating = True
End Sub
Chạy cái này....
Public Sub Main()
Dim Path As String
Path = ThisWorkbook.Path
TongHopFiles Path
End Subcho hỏi lệnh
là cái File ở chế độ ẩn do Bác Bill tạo ra... mình tạm keo nó là Files Tạm ~$tenFile.xls
[COLOR=#000000]Workbooks.Open[/COLOR]có cách nào không dùng Workbooks.Open để lấy dữ liệu không bạn, cám ơn
nếu ko sử dụng chữ to màu đò ta có thể xài ADO ....nhưng lúc nào cũng ADO hoài xưa như trái đất ... mất hứng..
hahahahavậy anh Mạnh làm cái code cho nó "Mạnh" để em học với .
....từ từ củ từ cũng sẻ nhừ ....Tất cả code này trong 1 macro hay sao bạn. bạn có thể hướng dẫn cụ thể hơn được không. thank bạn
đúng đó bạn ... Chay Sub Main
ủa còn cái vụ kia sao anh Mạnh ? cho em xem vài đường kiếm "Mạnh" mẽ đi .
