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

Respuesta
4

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
Respuesta
2

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 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas