Macro para Consolidar Varias Hojas de Libros Distintos

1. Los libros están todos es una carpeta que se llama Parte Diario

¿Cuál es el nombre completo de la ruta y carpeta?

2. La hoja que deseo consolidar de cada libro contiene las siglas "PD" y puede tener filas y columnas ocultas que NO DESEO CONSOLIDAR.

¿La hoja se llama "PD"?

3. La celda donde comienzan los datos es la B3 y allí esta el encabezado

¿Los encabezados están en la fila 3 y los datos empiezan en la fila 4?

¿Cómo se llama la hoja destino? Supongo que estará en el mismo libro que va a contener la macro.

¿Apróximandamente cuántas filas tienen cada archivo y cuántos archivo se consolidarán?

1. \\192.168.123.5\Compartidos\PARTE DIARIO

2. No la hoja tiene nombre que empieza por "PD". Pero si necesitas que se llamen igual lo cambio.

3. los encabezados están en la fila 3 y los datos comienzan en la fila 5.  

4. La hoja de destino se llama "Consolidado" y  estará en un libro que se llama consolidado y estará  en la misma carpeta. Desde este libro voy a ejecutar la macro. 

5. Los libros son 7 (siete) y tienen 304 filas; pero no todas se llenan diariamente; por eso quiero obviar las filas que estén en blanco. Y de paso hay filas escondidas con datos que tampoco quiero consolidar. 

Prueba la siguiente macro

Sub Consolidar()
'Dante Amor
  Dim wb2 As Workbook
  Dim sh As Worksheet, sh1 As Worksheet, sh2 As Worksheet
  Dim ruta As String, arch As Variant
  Dim i As Long, j As Long, lr As Long, lc As Long
  Dim una As Boolean
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  ruta = "C:\trabajo\PARTE DIARIO\"             'ruta y carpeta
  arch = Dir(ruta & "PARTE*.xls*")              'archivos con prefijo "PARTE"
  Set sh1 = ThisWorkbook.Sheets("Consolidado")
  sh1.Cells.ClearContents
  j = 5                                         'fila inicial en el destino
  '
  Do While arch <> ""
    Set wb2 = Workbooks.Open(ruta & arch)
    For Each sh In wb2.Sheets
      If UCase(Left(sh.Name, 2)) = "PD" Then    'hoja con prefijo "PD"
        If una = False Then
          sh.Rows("3:4").Copy sh1.Range("A3")   'fila encabezado
          una = True
        End If
        '
        lr = sh.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
        lc = sh.Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
        For i = 5 To lr
          If sh.Rows(i).EntireRow.Hidden = False Then
            If WorksheetFunction.CountA(sh.Rows(i)) > 1 Then
              sh1.Range("A" & j).Resize(1, lc).Value = sh.Range("A" & i).Resize(1, lc).Value
              j = j + 1
            End If
          End If
        Next i
        Exit For
      End If
    Next sh
    wb2.Close False
    arch = Dir()
  Loop
End Sub

¡Gracias! Dante sera que debo ajustar algo? la ejecuto y no hace nada

Cambia esto:

 ruta = "C:\trabajo\PARTE DIARIO\"  

Por tu ruta y nombre de carpeta:

ruta = "\\192.168.123.5\Compartidos\PARTE DIARIO\"

[prueba y me comentas

¡Gracias!  pero sigue sin hacer nada. tendrá algo que ver esto: 

  sh.Rows("3:4").Copy sh1.Range("A3")   'fila encabezado

porque la celda donde comienza el encabezado es B3. La columna A esta oculta y tiene datos que no deseo consolidar. 

Puedes poner un archivo ejemplo en tu misma computadora, en el disco "C" en alguna carpeta.

Puedes compartir en la nube, por ejemplo google drive, ese archivo archivo ejemplo.