Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'Nếu ta thay đổi DL (dữ liệu) của ô [E3] thì macro sẻ thực hiện dòng lệnh thức 2 trở về sau:'
1 If Not Intersect(Target, [E3]) Is Nothing Then
' Khai báo các biến cần dùng:'
Dim Rng As Range, Sh As Worksheet, sRng As Range
Dim MyAdd As String
' Gán trang 'NhapLieu} vô biến đã khai báo:'
3 Set Sh = Sheets("NhapLieu")
'Lấy vùng có DL của cột 'A' trang tính "NhapLieu" gán vô biến đã khai báo:'
Set Rng = Sh.Range(Sh.[A1], Sh.[A65500].End(xlUp))
'Tạo bãi đáp cho dữ liệu sẽ được macro tìm ra, bằng cách xoá DL cũ:'
5 [A5].Resize(Rng.Rows.Count, 6).ClearContents
'Tìm mã cần thiết trên vùng mà biến Rng đang lưu trữ:'
Set sRng = Rng.Find([E3].Value, , xlFormulas, xlWhole)
'Nếu tìm thầy thì thực hiện các lệnh trước dòng lệnh 15:'
7 If Not sRng Is Nothing Then
'Lấy địa chỉ tìm thấy gán vô biến chuỗi đã khai báo:'
MyAdd = sRng.Address
'Tạo vòng lặp đến dòng lệnh 14 để tìm hếu các mã có trong vùng thuộc biện Rng:'
9 Do
'TB (thông báo) sẽ làm việc với ô dưới 1 ô so với ô cuối cùng thuộc cột "A" có DL:'
With [A65500].End(xlUp).Offset(1)
'Cả 5 ô cùng dòng bắt đầu từ ô đã TB được gán trị từ 5 ô kể từ ô tìm thấy về fía fải:'
11 .Resize(, 5).Value = sRng.Offset(, 1).Resize(, 5).Value
End With 'Kết thúc TB'
'Tìm tiếp tục cho đến khi. . . '
13 Set sRng = Rng.FindNext(sRng)
'. . . . Không còn tìm thấy:'
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
' Nếu không tìm thấy:'
15 Else
MsgBox "Nothing" 'Hiện hộp thoại báo cho biết không tìm ra:'
17 End If
End If
End Sub
