adattando le indicazioni di Anthony ( che ringrazio e saluto) contenute in questo thread http://www.pc-facile.com/forum/viewtopic.php?t=105457 ho ottenuto quanto mi necessitava.
Ma ho bisogno di un "piccolo" aiuto per customerizzare ulteriormente lo script.
In breve, quando lancio la macro vorrei:
1) che mi chiedesse se voglio pulire i dati esistenti nel foglio ( al momento le interrogazioni si sommano accodandosi tra di loro) -> se SI cancella i dati presenti dalla riga 2 in giù, altrimenti continua ad accodarli.
2) riportare il numero di stringa digitato con la macro -> nella colonna D e creare un linea alla fine dell'ultimo dato trovato.
Lo script modificato è il seguente:
- Codice: Seleziona tutto
Sub myRiepilogo2()
Dim myMatch, myDir, myFile, i As Long, myNext As Long, myRiep As Worksheet, myLFor, myTot As Long
myLFor = InputBox("Digita la stringa da ricercare ")
If myLFor = "" Then
MsgBox ("Nessuna stringa specificata, la procedura viene interrotta...")
Exit Sub
End If
If IsNumeric(myLFor) Then myLFor = CDbl(myLFor)
myDir = "C:\Users\Bove\Downloads\Prova" '<<< La directory dei file, senza \ finale
Set myRiep = ThisWorkbook.Sheets("RIEP")
myFile = Dir(myDir & "\*.xls*")
Do While myFile <> ""
If myFile = "Riepilogo.xlsm" Then Exit Do
Workbooks.Open Filename:=(myDir & "\" & myFile), ReadOnly:=True
For i = 1 To Worksheets.Count
jj = Sheets(i).Cells(Rows.Count, 3).End(xlUp).Row
For j = 4 To jj
If Sheets(i).Cells(j, 3) = myLFor Then
myTot = myTot + 1
myNext = myRiep.Cells(Rows.Count, 1).End(xlUp).Row + 1
myRiep.Cells(myNext, 1) = ActiveWorkbook.Name
myRiep.Cells(myNext, 2) = Sheets(i).Name
myRiep.Cells(myNext, 3) = j
End If
Next j 'variata da me - era JJ
Next i
ActiveWorkbook.Close False
myFile = Dir
Loop
MsgBox ("Completato (" & myTot & " prodotto trovato)")
End Sub
https://www.dropbox.com/s/91uxt6fx6mjgsxd/Riepilogo.xlsm?dl=0
Grazie in anticipo