Post by Mauro Furlanettoadesso vi chiedo una ultima cosa :se volessi rendere la sub più flessibile ,
Volendo qualcosa di più elaborato ma forse che consente una certa "flessibilità" prova qualcosa del genere:
Sub TrovaParola()
Const sFoglio As String = "Foglio1"
Const iPrimaRigaDati As Long = 2
Const sColonnaRicerca As String = "U"
Const sColonnaScrittura As String = "G"
Const sParolaDaRicercare As String = "Libretto"
Dim Wb As Workbook
Dim Ws As Worksheet
Dim SrcRng As Range
Dim UltimaRiga As Long
Dim arrRicerca As Variant
Dim arrScrittura As Variant
Dim i As Long, NumRec As Long
Set Wb = ThisWorkbook
Set Ws = Wb.Worksheets(sFoglio)
With Ws
Set SrcRng = .Columns(sColonnaRicerca)
UltimaRiga = Application.Max(SrcRng.Find(What:="*", _
After:=SrcRng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row, iPrimaRigaDati)
With .Cells(iPrimaRigaDati, sColonnaRicerca). _
Resize(UltimaRiga - iPrimaRigaDati + 1)
arrRicerca = .Value
NumRec = .Rows.Count
End With
arrScrittura = .Cells(iPrimaRigaDati, sColonnaScrittura). _
Resize(UltimaRiga - iPrimaRigaDati + 1).Formula
For i = 1 To NumRec
If NumRec > 1 Then
If arrRicerca(i, 1) Like "*" & sParolaDaRicercare & "*" Then
arrScrittura(i, 1) = sParolaDaRicercare
End If
Else
If arrRicerca Like "*" & sParolaDaRicercare & "*" Then
arrScrittura = sParolaDaRicercare
End If
End If
Next i
.Cells(iPrimaRigaDati, sColonnaScrittura). _
Resize(UltimaRiga - iPrimaRigaDati + 1).Formula = arrScrittura
End With
End Sub
