Lista hojas libro y busca mediante criterios


El siguiente código busca en todas las hojas del libro, excepto en la primera, una vez encontrado los datos mediante bucles (parecido a función buscar V), los trae a la primer hoja, a su vez lista el nombre de la hoja en el cual aparece el dato encontrado.






Código a insertar en módulo


Sub Nomhoja()
'Evito movimientos en la pantalla
Application.ScreenUpdating = False
'Dimensiono variables
Dim fila, filah, conta As Integer
Dim hoja As Worksheet
Dim mihoja  As String
Dim valorcelda, concatena As String
fila = 2
filah = 2
conta = 0

'Controlo errores
On Error Resume Next

'para cada hoja del libro
For Each hoja In Worksheets
'filahoja = filahoja + 1
 mihoja = hoja.Name
'Realiza el bucle buscando un dato mientras la fila no esté vacia
 While Sheets("art").Cells(fila, 1) <> Empty And mihoja <> "Art"

    ' Realizó bucle en hoja donde busca datos
    While Sheets(mihoja).Cells(filah, 1) <> Empty And conta = 0
    dato1 = Sheets("art").Cells(fila, 1)
    dato2 = Sheets(mihoja).Cells(filah, 1)
     
      'Si el nombre de la columna uno de la hoja art es igual al nombre de la columna uno de la hoja correspondiente
       If dato1 = dato2 Then
 
      'es  decir si encontró el dato, copia la dirección en la hoja art y voy a la fila siguiente de la hoja correspondiente
      Sheets("art").Cells(fila, 3) = Sheets(mihoja).Cells(filah, 2)
     
      If Sheets("art").Cells(fila, 2) <> Empty Then
       'Sheets("art").Cells(fila, 2) = mihoja
       valorcelda = Sheets("art").Cells(fila, 2)
       concatena = valorcelda & "," & mihoja
       Sheets("art").Cells(fila, 2) = concatena
       Else
       Sheets("art").Cells(fila, 2) = mihoja
       End If
      'Si encontro el dato hago que el contador sea 1 para que no busque más
      conta = 1
     
      Else
     'Si no encontro el dato aumento la fila de la hoja address para seguir buscando hasta el final
      filah = filah + 1
      End If
    Wend
   
'Aumento en uno la fila para seguir buscando el dato siguiente de la hoja art
fila = fila + 1
'Vuelvo filah y contador a su valor de origen
filah = 2
conta = 0
'sigo bucle
Wend
'Vuelvo las variables a su valor de origen
fila = 2
filah = 2
conta = 0
'Proxima hoja
Next

'Vuelvo movimientos de la pantalla a su estado original
Application.ScreenUpdating = True
End Sub





Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.




If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends