Va la macro:
Private Sub CommandButton1_Click()
'MOLIENDA_CRUDO
Dim sh1 As Worksheet, sh2 As Worksheet, wb As Workbook
Dim i As Long, fila As Long, fila5 As Long, fila20 As Long
Dim m As Variant, h As Variant, hojas As Variant
Dim col As String
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sh1 = Sheets("MOLIENDA DE CRUDO")
sh1.Range("C5:U17, C20:U32").ClearContents
'
Set wb = Workbooks.Open("\\10.7.10.1\calidad\SEGUIMIENTO HORA-HORA\MOLIENDA DE CRUDO.xlsx", ReadOnly:=True)
'Set wb = Workbooks("MOLIENDA DE CRUDO")
hojas = Array("CRUDO 1", 5, "C", "CRUDO 2", 20, "C", "RETENIDO", 1, "T")
'
For h = 0 To UBound(hojas) Step 3
Set sh2 = wb.Sheets(hojas(h))
fila = hojas(h + 1)
col = hojas(h + 2)
fila5 = 5: fila20 = 20
For i = 2 To sh2.Range("A" & Rows.Count).End(3).Row
If Not IsError(sh2.Range("A" & i)) Then
If sh2.Range("A" & i).Value = sh1.Range("C2").Value Then
m = sh2.Cells(i, "B").Value * 1
sh1.Cells(fila, col) = IIf(m < 12 Or m = 24, m Mod 24 & ":00 AM", m Mod 12 & ":00 PM")
If col = "C" Then
sh1.Cells(fila, "D") = sh2.Range("C" & i).Value
sh1.Cells(fila, Columns("E").Column).Resize(1, 15).Value = sh2.Range("F" & i).Resize(1, 15).Value
Else
If sh2.Range("C" & i).Value = 1 Then fila = fila5: fila5 = fila5 + 1
If sh2.Range("C" & i).Value = 2 Then fila = fila20: fila20 = fila20 + 1
sh1.Cells(fila, col) = IIf(m < 12 Or m = 24, m Mod 24 & ":00 AM", m Mod 12 & ":00 PM")
sh1.Cells(fila, "U") = sh2.Range("D" & i).Value
End If
fila = fila + 1
End If
End If
Next i
Next h
'wb.Close False
If sh1.Range("C5, C20") = "" Then
MsgBox "No hay datos reportados para este día"
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub