Cerca valore rispettivo in colonna

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rng As Range
If Not Intersect(Target, Range("B2")) Is Nothing Then
With Sheets("Foglio1").Range("b4:b1000")
            Set rng = .Find(What:=Target.Value, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not rng Is Nothing Then
                rng.Cut Destination:=Cells(4, 2)
            Else
                MsgBox "Dato non trovato"
            End If
End With
End If
Cancel = True
End Sub

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim i As Long
    Dim col As Long
    Dim rig As Long
    
    If Not Intersect(Target, Range("G2,J2,M2")) Is Nothing Then
        col = Target.Column
        For i = 4 To Cells(Rows.Count, col).End(xlUp).Row
            If Cells(i, col) = Target Then Exit For
        Next i
        Cells(4, col).Select
        ActiveWindow.SmallScroll Down:=i - 4
    End If
    If Not Intersect(Target, Range("B5,B8,B11")) Is Nothing Then
        rig = Target.Row
        For i = 4 To Cells(rig, Columns.Count).End(xlToLeft).Column
            If Cells(rig, i) = Target Then Exit For
        Next i
        Cells(rig, 4).Select
        ActiveWindow.SmallScroll ToRight:=i - 4
    End If
    Cancel = True

End Sub