Tìm vùng dữ liệu bằng VBA

[Vũ Đại Hiệp]

Em xin chào các bác, các anh / chị
File Excel của em có 14 hợp đồng.
Tại Sheet " Bảng kê " em muốn dò tìm 1 vùng dữ liệu hiện thị tại ô A10 : Q 33 với giá trị dò tìm ở ô C37 ( C37 là số hợp đồng, được tăng lên giảm xuống qua nút ấn ), và vùng dò tìm ở Sheet " Phụ lục".
Em mong nhận được sự giúp đỡ của các bác, anh chị trong diễn đàn. Chúc mọi người một buổi chiều vui vẻ ạ

Bạn cần đăng nhập để thấy link

 

[Binana]

Em xin chào các bác, các anh / chị
File Excel của em có 14 hợp đồng.
Tại Sheet " Bảng kê " em muốn dò tìm 1 vùng dữ liệu hiện thị tại ô A10 : Q 33 với giá trị dò tìm ở ô C37 ( C37 là số hợp đồng, được tăng lên giảm xuống qua nút ấn ), và vùng dò tìm ở Sheet " Phụ lục".
Em mong nhận được sự giúp đỡ của các bác, anh chị trong diễn đàn. Chúc mọi người một buổi chiều vui vẻ ạ

Bạn cần đăng nhập để thấy link

Sub ABC()
Dim iR&, DK&, X&
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    iR = Sheets("Phu Luc").Range("C" & Rows.Count).End(3).Row
    DK = Sheets("Bang Ke").Range("C37").Value
    Sheets("Bang Ke").Range("A10:Q33").ClearContents
    For X = 7 To iR Step 25
        If Sheets("Phu Luc").Range("A" & X).Value = DK Then
            Sheets("Phu Luc").Range("B" & X).Resize(24, 17).Copy
            Sheets("Bang Ke").Range("A10").PasteSpecial Paste:=xlPasteValues
            Exit For
            Application.CutCopyMode = False
        End If
    Next
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Ban thử code này và thay đổi tên sheet thành Phu Luc và Bang Ke viết không dấu nhé

 

[Vũ Đại Hiệp]

Sub ABC()
Dim iR&, DK&, X&
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    iR = Sheets("Phu Luc").Range("C" & Rows.Count).End(3).Row
    DK = Sheets("Bang Ke").Range("C37").Value
    Sheets("Bang Ke").Range("A10:Q33").ClearContents
    For X = 7 To iR Step 25
        If Sheets("Phu Luc").Range("A" & X).Value = DK Then
            Sheets("Phu Luc").Range("B" & X).Resize(24, 17).Copy
            Sheets("Bang Ke").Range("A10").PasteSpecial Paste:=xlPasteValues
            Exit For
            Application.CutCopyMode = False
        End If
    Next
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Ban thử code này và thay đổi tên sheet thành Phu Luc và Bang Ke viết không dấu nhé

Em cám ơn bác nhiều nhé, hì hì. Mấy ngày nghỉ phép không có máy tính không vào được lên không cám ơn bác kịp thời được. Chúc bác nghỉ lễ vui vẻ bên gia đình ạ