Per esigenze di lavoro, avrei bisogno di ricercare un determinato valore (solitamente un numero) su più file excel che aumentano ogni settimana e mi restituisce il nome del file excel in cui si trova il valore cercato e le celle accanto al valore cercato che sono 2 o 3. il valore che cerco è però sempre presente in tutti file excel, ma in alcuni ha un valore accanto, in altri ha celle vuote. Io vorrei che mi restituisse solo quelle con un valore accanto al valore cercato. Allego un file di esempio in cui foglio 1 e foglio 2 corrispondo a file excel diversi da dove cercare e "output" il file in cui avere i dati che cerco. Inoltre cercando in rete ho trovato un codice che però mi restituisce solo il nome del file (ovvero tutti).
- Codice: Seleziona tutto
Option Explicit
Public Sub mRicerca(ByVal vRicerca As Variant, sPath As String)
'dichiaro le variabili
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim wk As Workbook
Dim sh As Worksheet
Dim shMe As Worksheet
Dim lUltRiga As Long
Dim c As Range
'impedisco lo sfarfallio del monitor
With Application
.ScreenUpdating = False
End With
'metto un riferimento al Foglio1
'di questa cartella di Excel
Set shMe = ThisWorkbook.Worksheets("Foglio1")
'trovo l'ultima riga con dati
'della colonna A, Foglio1,
'di questa cartella di Excel
With shMe
lUltRiga = .Range( _
"A" & .Rows.Count _
).End(xlUp).Row
End With
'creo duo oggetti
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(sPath)
'ciclo i files della cartella
For Each objFile In objFolder.Files
'se sono files di Excel
Select Case LCase(Right(objFile.Name, 4))
Case ".xls", "xlsx", "xlsm"
'li apro
Set wk = Workbooks.Open(objFile.Path)
'ciclo i fogli
For Each sh In wk.Worksheets
'ciclo le celle dei fogli
For Each c In sh.UsedRange
'se il contenuto della cella
'corrisponde al valore cercato
If c.Value = vRicerca Then
'nuova riga in Foglio1 di questa
'cartella
lUltRiga = lUltRiga + 1
'recupero il nome del file
shMe.Range("A" & lUltRiga).Value = _
objFile.Name
End If
Next
'chiudo il file
wk.Close
'Set a Nothing della variabile oggetto
Set wk = Nothing
Next
End Select
Next
'ripristino l'update del monitor
With Application
.ScreenUpdating = True
End With
'Set a Nothing delle variabili oggetto
Set c = Nothing
Set wk = Nothing
Set sh = Nothing
Set shMe = Nothing
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
End Sub
'richiamo la routine mRicerca
Public Sub m()
'cerco il valore 1 in tutti i fogli
'dei files presenti nella cartella
'C:\Cartella
Call mRicerca(1, "C:\cartella")
End Sub
Grazie a tutti
https://we.tl/BwZ2WoNIhD