Chuyển những dữ liệu đã lọc sang sheet khác và đặt tên sheet mới bằng từ khoá lọc (1 người xem)

[lehuong1409]

E lò dò học VBA nên chỉ biết mỗi cách Record Macro để tạo Code thôi, E đã tạo được phần tìm kiếm dữ liệu, tách dữ liệu sang sheet khác nhưng không biết làm thế nào đặt tên sheet mới vừa được tạo bằng chính từ khoá mình tìm kiếm trong ô tìm kiếm ở trên. Mong các anh chị xem file và chỉnh thêm giúp em, với lại có cách nào để copy mang nguyên cả định dạng bảng biểu sang không ạ? E cảm ơn!

 

[lehuong1409]

Rảnh viết cho bạn cái code tổng hợp thay thế code trong file của bạn

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 Sub

Em đã dùng code của anh, nhanh quá ạ 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

 

[lehuong1409]

Em cảm ơn ạ! Có gì em chưa hiểu, còn thắc mắc mong anh vẫn sẽ giúp đỡ em ạ. Chúc các anh chị một buổi tối thật vui ạ!

 

[lehuong1409]

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 Sub

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

Em có tìm hiểu code anh giúp em nhưng đoạn này em chưa hiểu đc. Mong anh chỉ giáo thêm.

 

[lehuong1409]

For 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
E cảm ơn anh nhiều ạ, e đã vỡ vạc đc nhiều, e k hiểu là biến i sử dụng với số thứ tự nên cứ bị rối. Nhưng em còn 1 thắc mắc nữa ở Code anh làm giúp em. Em thử dùng F8 để xem kết quả của anh nhưng đến đoạn này nó mới lên hết kết quả

[B]If I Then Sheets("TH").Range("A2").Resize(I, 7) = Kq[/B]

 Nhưng em thấy nếu [I]If [/I][I]thì phải có End IF và em thường thấy hay gắn cho I một giá trị nào đó sao ở code của anh em không thấy. 
P/s:Vì hôm trước e có chút chuyện về quê nên chỉ cảm ơn trên điện thoại được mà chưa sử dụng đc để hỏi anh luôn. Cảm ơn anh đã quan tâm giải đáp giúp em[/I]

 

[lehuong1409]

Cứ Viết If I then "cần làm gì đó" thì không cần End if (vì trên 1 dòng) Nếu cụm "Cần làm gì đó" được xuống dòng thì mới cần end if. Còn nó ở trên dòng If ...then thì không cần end if. Thế thôi

Còn tại sao là If I then mà không phải If I = cái gì đó then thì If I coi như là xét I = true (mà true có nghĩa là I > 0, cõ nghĩa là I tồn tại, hay là I khác 0). Vậy thôi

Quá dễ hiểu ạ, Cảm ơn anh đã nhiệt tình chỉ bảo!

 

[lehuong1409]

Chúc mọi người ngày mới tốt lành ạ