Public Sub GPE()
Dim Arr(1 To 65000, 1 To 8), ArrTem(), WS As Worksheet, I As Long, J As Long, K As Long, Lop As String
For Each WS In Worksheets
If WS.Name <> "TONG HOP" Then
Lop = WS.Name
ArrTem = WS.[A6].Resize(50, 6).Value
For I = 1 To UBound(ArrTem, 1)
K = K + 1
If ArrTem(I, 1) <> "" Then
Arr(K, 1) = Lop
Arr(K, 2) = K
For J = 1 To 6
Arr(K, J + 2) = ArrTem(I, J)
Next J
End If
Next I
End If
Next
With Sheets("TONG HOP")
.[A1:H10000].ClearContents
.[A1].Resize(K, 8).Value = Arr
End With
End Sub
Nếu một cách tổng quát bạn tham khảo bài viết của huuthang_bd xem: Tách, gộp dữ liệu trên nhiều file
- Tất cả các sheet đều định dạng kiểu Text, muốn "Đảm bảo định dạng" thì chọn cả sheet TONG HOP định dạng kiểu Text. (Lỗi do dữ liệu của bạn)
Public Sub GPE()
Dim Arr(1 To 65000, 1 To 50), ArrTem(), WS As Worksheet, I As Long, J As Long, K As Long, Lop As String
For Each WS In Worksheets
If WS.Name <> "TONG HOP" Then
Lop = WS.Name
ArrTem = WS.[A6].Resize(50, 48).Value
For I = 1 To UBound(ArrTem, 1)
K = K + 1
If ArrTem(I, 1) <> "" Then
Arr(K, 1) = Lop
Arr(K, 2) = K
For J = 1 To 48
Arr(K, J + 2) = ArrTem(I, J)
Next J
End If
Next I
End If
Next
With Sheets("TONG HOP")
.[A6].Resize(10000, 50).ClearContents
.[A6].Resize(K, 50).Value = Arr
End With
End Sub
Em nghĩ phải vầy mới ổn:
Sub CollectAllWks()
Dim Arr(1 To 65000, 1 To 44), aSrcData, aDate
Dim lR As Long, lC As Long, k As Long
Dim sDate As String, tmp As String
Dim wks As Worksheet, wksDes As Worksheet
On Error Resume Next
Set wksDes = ThisWorkbook.Worksheets("TONG HOP")
For Each wks In ThisWorkbook.Worksheets
If UCase(wks.Name) <> UCase(wksDes.Name) Then
aSrcData = wks.Range("A6:AP55").Value
For lR = 1 To 50
k = k + 1
tmp = Trim(aSrcData(lR, 1))
If Len(tmp) Then
Arr(k, 1) = wks.Name
Arr(k, 2) = k
For lC = 1 To 42
If lC = 1 Then aSrcData(lR, 1) = "'" & aSrcData(lR, 1)
If lC = 4 Or lC = 25 Then
sDate = aSrcData(lR, lC)
If TypeName(sDate) = "String" Then
aDate = Split(sDate, "/")
aSrcData(lR, lC) = DateSerial(aDate(2), aDate(1), aDate(0))
End If
End If
Arr(k, lC + 2) = aSrcData(lR, lC)
Next
End If
Next
End If
Next
If k Then
With wksDes
.Range("A2:AR10000").ClearContents
.Range("F2:F10000").NumberFormat = "dd/mm/yyyy"
.Range("AA2:AA10000").NumberFormat = "dd/mm/yyyy"
.Range("A2:AR2").Resize(k).Value = Arr
End With
End If
End SubSử dụng code của ndu96081631.
Vậy bạn đã mở file GPE666 ở bài #8 bên trên chưa?
Nên bỏ đi những dòng trống thừa không cần thiết anh à.
