Salve... avrei bisogno di modificare questa macro.... nn essendo molto pratico nn so nemmeno dove metter le mani...
Vorrrei poter stampare l'intera riga relativa alla cella selezionata.....
La acro in pratica inidvidua la cella ricercata ma stampa le info relative alla posizione xtc... a me occorre solo la riga corrispondente e magari anche l'header di prima riga .... come se fa???
allego la macor in io possesso
Sub RicercaTutto()
Dim cell As Range, ValRech
Dim Wbk As Workbook, Sht As Worksheet
Dim ResRech As Workbook, i As Long
ValRech = Application.InputBox("Valore a cercare :", Type:=1 + 2)
If Len(ValRech) = 0 Or ValRech = False Then Exit Sub
Set ResRech = Workbooks.Add
With ResRech.Sheets(1)
.Cells(1, 1).Value = "Nom"
.Cells(1, 2).Value = "riga"
.Cells(1, 3).Value = "Classeur"
.Cells(1, 4).Value = "Cellule"
.Cells(1, 5).Value = "Valeur"
.Cells(1, 6).Value = "Formule"
End With
i = 1
Application.ScreenUpdating = False
For Each Wbk In Application.Workbooks
If Wbk.IsAddin = False And Not Wbk Is ResRech Then
For Each Sht In Wbk.Worksheets
For Each cell In Sht.UsedRange
If cell.Value = ValRech Then
i = i + 1
With ResRech.Sheets(1)
On Error Resume Next
.Cells(i, 1).Value = cell.Parent.Parent.Name
.Cells(i, 2).Value = cell.Parent.Name
.Cells(i, 3).Value = cell.Name.Name
.Cells(i, 4).Value = cell.Address
.Cells(i, 5).Value = cell.Value
If cell.HasFormula Then
If cell.HasArray Then
.Cells(i, 6).Value = "{" & cell.FormulaLocal & "}"
Else
.Cells(i, 6).Value = "'" & cell.FormulaLocal
End If
End If
On Error GoTo 0
End With
End If
Next cell
Next Sht
End If
Next Wbk
Application.ScreenUpdating = True
If Application.CountA(ResRech.Sheets(1).Range("A2:F2" )) > 0 Then
'per provare
ResRech.Sheets(1).PrintPreview
'per stampare :
' ResRech.Sheets(1).PrintOut
End If
ResRech.Close False
End Sub
Grazie a tutti
