Snasui Excel Forum

Code: Select all

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

        If Not Intersect(Target, Range("B2")) Is Nothing Then
            Call GetData
        End If
End Sub

Code: Select all

Option Explicit

Sub GetData()


            Dim rFind As Range, rDataAll As Range
            Dim r As Range, rTarget As Range
            Dim ws As Worksheet
            Set ws = Worksheets("sheet1")
            Set rFind = Sheets("sheet1").Range("B2")
            
            ws.Range("E7:F10").ClearContents
            
            If Sheets("sheet1").Range("B2") = "" Then Exit Sub
            
            With Sheets("sheet1")
                Set rDataAll = .Range("A7", .Range("A" & Rows.Count).End(xlUp))
                If .Columns("A:A").Find(rFind, LookIn:=xlValues) Is Nothing Then
                    MsgBox ("ไม่มีเลขนี้")
                    Exit Sub
                End If
            End With
            
            For Each r In rDataAll
                If r = rFind Then
                    Set rTarget = Sheets("sheet1").Range("E" & Rows.Count).End(xlUp) _
                        .Offset(1, 0)
                    r.Resize(1, 2).Copy
                    rTarget.PasteSpecial xlPasteValues
                End If
            Next r
            Application.CutCopyMode = False
            MsgBox "Get data has finished."
            Set ws = Nothing
            Set rFind = Nothing
            Set rDataAll = Nothing
End Sub