Thì cũng đành mò mẫmEm ghé qua đây đầu tiên là khoe là em cũng đã áp dụng ghi macro và mấy dòng code của các anh chị chỉ cho em vào công việc của mình, thấy "ưng cái bụng" lắm ạEm cảm ơn các anh chị đã ghé qua giúp đỡ em. Nhân đây em muốn hỏi ké một dòng code với ạ
Khi em tổng hợp dữ liệu từ các sheet sang sheet tổng hợp thì em muốn giữ nguyên dòng đầu tiên (Phần tiêu đề) và chạy code cho file tổng hợp tự có filter ở Dòng đầu tiên đó, nhưng khi em cho chạy code thì lần đầu có filer lần thứ 2 lại không có (đã filter rồi lại chọn nút filter nên nó trở về trạng thái ban đầu). Nên em muốn hỏi là em muốn viết 1 code có nghĩa " Nếu đã filter thì giữ nguyên, còn chưa filter thì filter" thì phải viết thế nào ạ?/ E xin chân thành cảm ơn ạ!
Cảm ơn anh, e sẽ rút kinh nghiệm cho lần sau. E gửi kèm file anh xem giúp em với ạ. E muốn để dòng đầu tiên bên sheet tổng hợp luôn ở trạng thái filter ạ.
Vâng ạ
Sub GPE()
Dim DL, Ws As Worksheet, Kq(1 To 65000, 1 To 7)
Dim r As Long, I As Long, J As Long
Application.ScreenUpdating = False
For Each Ws In Worksheets
If Ws.Name <> "TH" Then
DL = Ws.Range(Ws.[B5], Ws.[B65000].End(3)).Resize(, 5)
For r = 1 To UBound(DL)
If DL(r, 1) <> Empty Then
I = I + 1
Kq(I, 1) = I
For J = 1 To UBound(DL, 2)
Kq(I, J+1) = DL(r, J)
Next J
Kq(I, 7) = Ws.Name
End If
Next r
End If
Next Ws
Sheets("TH").AutoFilterMode = False
Sheets("TH").Range("A2:G65000").ClearContents
If I Then Sheets("TH").Range("A2").Resize(I, 7) = Kq
Sheets("TH").Range("A1:G" & Sheets("TH").Range("A65000").End(3).Row).AutoFilter
Application.ScreenUpdating = True
End SubVì em đang trong quá trình bập bẹ với VBA nên em học code phần lớn dựa trên việc ghi macro và tìm kiếm câu lệnh đơn giản nên code đang khá dài. Cảm ơn anh đã bớt chút thời gian chia sẻ với đề tài của em
e còn cần học hỏi nhiều mới có thể vận dụng kiến thức như các anh chị trên diễn đàn được. Nhân đây anh có thể giúp luôn em Code để tạo boder cho phần tổng hợp với ạ. em có ghi macro định dạng rồi nhưng code nó dài quá nhưng chưa biết cách nào tinh gọn code định dạng boder hơn 
Em đã dùng code của anh, nhanh quá ạ
Sub GPE()
Dim DL, Ws As Worksheet, Kq(1 To 65000, 1 To 7)
Dim r As Long, I As Long, J As Long
Application.ScreenUpdating = False
For Each Ws In Worksheets
If Ws.Name <> "TH" Then
DL = Ws.Range(Ws.[B5], Ws.[B65000].End(3)).Resize(, 5)
For r = 1 To UBound(DL)
If DL(r, 1) <> Empty Then
I = I + 1
Kq(I, 1) = I
For J = 1 To UBound(DL, 2)
Kq(I, J + 1) = DL(r, J)
Next J
Kq(I, 7) = Ws.Name
End If
Next r
End If
Next Ws
Sheets("TH").AutoFilterMode = False
Sheets("TH").Range("A2:G65000").ClearContents
Sheets("TH").Range("A2:G65000").Borders.LineStyle = xlNone
If I Then Sheets("TH").Range("A2").Resize(I, 7) = Kq
Sheets("TH").Range("A2:G" & Sheets("TH").Range("A65000").End(3).Row).AutoFilter
Sheets("TH").Range("A2:G" & Sheets("TH").Range("A65000").End(3).Row).Borders.LineStyle = xlContinuous
Sheets("TH").Range("A2:G" & Sheets("TH").Range("A65000").End(3).Row).Borders(xlInsideHorizontal).Weight = xlHairline
Application.ScreenUpdating = True
End SubFor r = 1 To UBound(DL) 'Duyệt từ dòng 1 tới dòng cuối của mảng DL
If DL(r, 1) <> Empty Then 'Nếu dòng(r, cột 1) của mảng DL khác Rỗng thì
I = I + 1 'Cho biến i tăng thêm 1 nếu thỏa điều kiển (mặc định i = 0)
Kq(I, 1) = I 'Gán cho cột đầu tiên của mảng kết quả = I (xem như số thứ tự tăng dần)
For J = 1 To UBound(DL, 2) ' Duyệt từ cột 1 đến cột cuối của mảng DL
Kq(I, J + 1) = DL(r, J) ' Gán kết quả từ cột 2 trở đi của mảng kết quả (cột tương ứng với mảng DL) Phải cộng thêm 1 (J+1) vì lúc nãy ở trên cột 1 ta đã gán Số thứ tự (I) rồi
Next J
