Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
A better way to browse. Learn more.
A full-screen app on your home screen with push notifications, badges and more.
Este tema está ahora archivado y está cerrado a más respuestas.
Hola Amigos del Foro
Necesito su ayuda he conseguido una Macro que se acopla a mis necesidades tengo un archivo con mas de 60 hojas todas tienen el mismo formato y necesito hacer una búsqueda para que me traiga el resultado de cada hoja hasta ahí todo iba bien es mas me trae el resultado si este esta en formato "Texto".
Pero la mayoría de los filtros que necesito traer estan en formato Números Ejem: " Referencia 917" esos datos no me los trae y NO tengo idea por que.
Adjunto archivo
Cita Cita Sub Buscador() Dim sNoBuscar As String Dim wHoja As Worksheet Dim sCodEBS As String Dim nSubCoincide As Double Dim nTotCoincide As Double Dim wHojaResumen As Worksheet Dim firstAddress Dim c As Range Dim nFilaCopia As Double Dim sDescripcion As String Dim sReferencia As String Dim rRangoBusca As Range Dim sBusca As String Dim bValido As Boolean Set wHojaResumen = Worksheets("Busqueda") wHojaResumen.Select nFilaCopia = wHojaResumen.Range("B" & Rows.Count).End(xlUp).Row wHojaResumen.Range("A9:AE" & nFilaCopia + 9).ClearContents wHojaResumen.Range("A9:AE" & nFilaCopia + 9).Borders.LineStyle = xlNone sNoBuscar = "Busqueda;" sDescripcion = Trim(wHojaResumen.Range("B2").Value) sReferencia = Trim(wHojaResumen.Range("B3").Value) nFilaCopia = 9 For Each wHoja In ActiveWorkbook.Sheets nSubCoincide = 0 If InStr(1, sNoBuscar, wHoja.Name) = 0 Then If sDescripcion <> "" Then nSubCoincide = Application.WorksheetFunction.CountIf(wHoja.Range("C:C"), "*" & Trim(sDescripcion) & "*") Set rRangoBusca = wHoja.Range("C:C") sBusca = sDescripcion ElseIf sReferencia <> "" Then nSubCoincide = Application.WorksheetFunction.CountIf(wHoja.Range("D:D"), "*" & Trim(sReferencia) & "*") Set rRangoBusca = wHoja.Range("D:D") sBusca = sReferencia ElseIf sEditorial <> "" Then End If If nSubCoincide > 0 Then With rRangoBusca Set c = .Find("*" & sBusca & "*", LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then firstAddress = c.Address Do bValido = True If sDescripcion <> "" Then If InStr(1, Trim(wHoja.Range("C" & c.Row)), Trim(sDescripcion)) = 0 Then bValido = False End If End If If sReferencia <> "" And bValido = True Then If InStr(1, Trim(wHoja.Range("D" & c.Row)), Trim(sReferencia)) = 0 Then bValido = False End If End If If bValido = True Then wHojaResumen.Range("A" & nFilaCopia).Value = "'" & wHoja.Range("A" & c.Row) wHojaResumen.Range("B" & nFilaCopia).Value = wHoja.Range("B" & c.Row) wHojaResumen.Range("C" & nFilaCopia).Value = wHoja.Range("C" & c.Row) wHojaResumen.Range("D" & nFilaCopia).Value = wHoja.Range("D" & c.Row) wHojaResumen.Range("E" & nFilaCopia).Value = wHoja.Range("E" & c.Row) wHojaResumen.Range("F" & nFilaCopia).Value = wHoja.Range("F" & c.Row) wHojaResumen.Range("G" & nFilaCopia).Value = wHoja.Range("G" & c.Row) wHojaResumen.Range("H" & nFilaCopia).Value = wHoja.Range("H" & c.Row) wHojaResumen.Range("I" & nFilaCopia).Value = wHoja.Range("I" & c.Row) wHojaResumen.Range("J" & nFilaCopia).Value = wHoja.Range("J" & c.Row) wHojaResumen.Range("K" & nFilaCopia).Value = wHoja.Range("K" & c.Row) nFilaCopia = nFilaCopia + 1 End If Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If End With End If End If Next nFilaCopia = wHojaResumen.Range("B" & Rows.Count).End(xlUp).Row If nFilaCopia > 8 Then wHojaResumen.Range("A9:AE" & nFilaCopia).Borders.LineStyle = xlContinuous End If End Sub
Filtro Varias Hojas y Consolida informacion en 1 Sola.xlsm