Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' L'Obiettivo è trovare prezzo e codice una volta noti Tipologia, Spessore e DN
' I valori cercati si trovano nelle rispettive tabelle poste nel foglio2
' Il prezzo si trova incrociando i dati del DN e dello spessore nella tabella riferita alla tipologia scelta
' Il codice invece sarà dato dalla tipologia aggiungendo due lettere una in corriposndenza dello spessore e l'altra del DN
' Quindi riepilogando si avrà:
' L'importo sarà dato da foglio2.cells(MyRow, MyColumn)
' il codice sarà dato da codTable & x & y
' in cui
' x = foglio2.cells(MyRowSP, MyColumn)
' y = foglio2.cells(MyRow, MyColumnDN)
' Si tratta di valorizzare tutte le variabili richiamate

' Prima dichiaro le varibili
Dim thisRow As Integer, MyRow As Integer, MyColumn As Integer, Tipologia As String, DN As Integer, Spessore As Integer, _
Importo As Currency, MyTable As Range, MyRange As Range, cell As Range, _
codTable As Range, x As String, y As String, MyColumnDN As Integer, MyRowSP As Integer

thisRow = Target.Row

If Target.Column = 6 And Cells(thisRow, 2) <> "" And Cells(thisRow, 3) <> "" And Cells(thisRow, 4) <> "" Then
Tipologia = Cells(thisRow, 2)
DN = Cells(thisRow, 3)
Spessore = WorksheetFunction.Ceiling(Cells(thisRow, 4), 1)

On Error Resume Next
Set MyTable = Foglio2.Cells.Find(what:=Tipologia, lookat:=xlWhole).CurrentRegion
Set codTable = MyTable.Find(what:="TABELLA", lookat:=xlPart)
    If MyTable Is Nothing Or codTable Is Nothing Then
    MsgBox "Non ci sono valori validi", vbCritical
    Exit Sub
    End If
On Error GoTo 0

With MyTable.Find(what:=DN, lookat:=xlWhole)
MyRow = .Row 'variabile trovata
MyColumnDN = .Column + 1 'variabile trovata
End With
' Visto il modo in cui sono stati scritti i valori degli spessori nelle celle del foglio2 mi conviene procedere come segue:
' costruisco una matrice con tutti i valori e poi verifico in quale intervallo si trova quello che ho scelto
Dim MatriceSp(), n As Byte, m As Byte, sp As Byte, UnderS As Byte
Set MyRange = MyTable.Find(what:="spessore", lookat:=xlPart).Offset(1)
n = MyRange.End(xlToRight).Column - MyRange.Column + 1 ' n. righe della matrice contenente gli spessori
ReDim MatriceSp(1 To n, 2)
For Each cell In Foglio2.Range(MyRange.Address, MyRange.End(xlToRight).Address)
m = m + 1
MatriceSp(m, 0) = CInt(Split(cell, "-")(0))
MatriceSp(m, 1) = CInt(Split(cell, "-")(1))
MatriceSp(m, 2) = cell.Column
Next
' Ho appena costruito la matrice MatriceSp con tutti gli spessori e cerco in quale intervallo è compreso quello che ho scelto
    For sp = 1 To n
    If Spessore >= MatriceSp(sp, 0) And Spessore <= MatriceSp(sp, 1) Then
    MyColumn = MatriceSp(sp, 2) 'variabile trovata
    MyRowSP = MyTable.Find(what:=MatriceSp(sp, 0) & " - " & MatriceSp(sp, 1), lookat:=xlWhole).Row 'varibile trovata
    x = Left(Foglio2.Cells(MyRowSP + 2, MyColumn), 1) 'variabile trovata
    y = Foglio2.Cells(MyRow, MyColumnDN)  'variabile trovata
    Exit For
    End If
    Next
    ' Se lo spessore è fuori Range esce dalla routine con MsgBox di avviso
    If MyColumn = 0 Or MyRowSP = 0 Then
    MsgBox "Valori non inclusi nell'intervallo degli spessori", vbCritical
    Exit Sub
    End If

' compongo tutte le varibili trovate e li riporto nel foglio1 con il doppio clic sulla colonna F
Foglio1.Cells(thisRow, 5).Value = Foglio2.Cells(MyRow, MyColumn) 'Questo è l'importo
UnderS = InStr(1, codTable, "_")
Foglio1.Cells(thisRow, 6).Value = Mid(codTable, 9, UnderS - 9) & x & y 'Questo è il Codice depurato dagli underscore_
End If

End Sub