Extraer datos de hojas de libro y acomodar según valor deseado en otra hoja
Espero alguien me pueda ayudar el problema es el siguiente, tengo un libro con 31 hojas(los días del mes) las cuales voy llenando diariamente en la columna A es el código del producto, Columna B es el modelo, columna C es el numero de tarima y la G es la fecha, durante el día diferentes productos van en diferente tarima y son colocadas en las filas A2:G2 lo que necesito hacer es, ver la manera de en una hoja llamada datos pueda jalar la información referente al numero de tarima, por ejemplo que ponga en una celda el numero de tarima deseada, dar click a un command button y busque en todas las hojas los datos que están en esa tarima y me las acomode en una lista, creen que sea posible.
2 Respuestas
Prueba la siguiente macro.
En la hoja "Datos" en la celda A2 pon el número de tarima
Los resultados estarán en la hoja "Datos" de la fila 4 hacia abajo.
Sub Extraer_datos()
Dim sh As Worksheet, tarima As String, lr As Long
'
Application.ScreenUpdating = False
With Sheets("Datos")
.Rows("4:" & Rows.Count).ClearContents
tarima = .Range("A2").Value
For Each sh In Worksheets
If LCase(sh.Name) <> LCase(.Name) Then
If sh.AutoFilterMode Then sh.AutoFilterMode = False
sh.Range("C1", sh.Range("C" & Rows.Count).End(xlUp)).AutoFilter 1, tarima
lr = .Range("C" & Rows.Count).End(3).Row + 1
If lr < 4 Then lr = 4
sh.AutoFilter.Range.Offset(1).EntireRow.Copy .Range("A" & lr)
sh.ShowAllData
End If
Next
End With
End Sub
Hola dante me sirvió mucho tu código pero tengo algunas preguntas y dudas, veo que lo que hiciste es hacer un autofiltro en cada hoja y copiar la información a la hoja datos, mi problema es que si en caso que tenga otra hoja en la cual no tenga datos, el programa se detiene y en el código me aparece amarillo la siguiente línea "sh.Range("C1", sh.Range("C" & Rows.Count).End(xlUp)).AutoFilter 1, tarima" hay alguna manera de excluir hojas para que no afecte eso, y otra pregunta más, los datos se pegan en la hoja " datos" de A4 hacia abajo, ¿hay manera de que se peguen de B4 hacia abajo?
Prueba lo siguiente:
Sub Extraer_datos()
Dim sh As Worksheet, tarima As String, lr As Long
Dim lr1 As Long
'
Application.ScreenUpdating = False
With Sheets("Datos")
.Rows("4:" & Rows.Count).ClearContents
tarima = .Range("A2").Value
For Each sh In Worksheets
If LCase(sh.Name) <> LCase(.Name) Then
If sh.AutoFilterMode Then sh.AutoFilterMode = False
lr1 = sh.Range("C" & Rows.Count).End(xlUp).Row
If lr1 > 1 Then
sh.Range("C1:C" & lr1).AutoFilter 1, tarima
lr = .Range("C" & Rows.Count).End(3).Row + 1
If lr < 4 Then lr = 4
On Error Resume Next
sh.Range("A2:G" & lr1).SpecialCells(xlCellTypeVisible).Copy .Range("B" & lr)
On Error GoTo 0
sh.ShowAllData
End If
End If
Next
End With
End Sub
Esta macro te servirá. Ajusta la ubicación de los datos del resultado. En mi ejemplo de la imagen la hoja se llama Consulta y los resultados se ubican a partir de D2.
Sub BUSCAR_DATO()
'x Elsamatilde
Set hoc = Sheets("Consulta")
dato = [C2] 'ajustar donde se ubica la tarima a buscar
'los resultados se ubican a partir de celda D2 (ajustar)
y = 2
'se recorren todas las hojas
i = 1
Do
If Sheets(i).Name <> "Consulta" Then
'fin del rango de cada hoja
x = Sheets(i).Range("C" & Rows.Count).End(xlUp).Row
For Each cd In Sheets(i).Range("C2:C" & x)
If cd.Value = dato Then
'se vuelcan los datos del registro encontrado
hoc.Range("D" & y) = cd.Offset(0, -2)
hoc.Range("E" & y) = cd.Offset(0, -1)
hoc.Range("F" & y) = cd.Offset(0, 1)
y = y + 1
End If
Next cd
End If
i = i + 1
'continua el bucle para el resto de las hojas
Loop While i <= Sheets.Count
MsgBox "Fin de la búsqueda"
End Sub
Observa que la macro omite la búsqueda en esa hoja Consulta o como la llames. Si el libro tiene otras hojas que no deben ser recorridas incluilas en la condición. Por ejemplo:
If Sheets(i).Name <> "Consulta" and Sheets(i).Name <> "PORTADA" Then