Desafortunadamente no pude abrir el archivo, así que me faltaron llenar algunos datos, no sé si ya los estés llenando con alguna fórmula o envíame tu archivo a [email protected] para completarlos; mientras realiza las pruebas con la nueva macro. Asegúrate de que en la columna D exista el título “TIPO PRODUCTO”, en la imagen que me enviaste aparece en la celda D22, así que si este título aparece en la columna D, sin importar la fila, la macro podrá encontrar la fila y de ahí pegar los datos de los resultados.
Te cambio la macro
Sub bultos()
'cuenta el número de bultos
'Por.Dam
hoja = ActiveSheet.Name
Worksheets.Add
hojab = ActiveSheet.Name
'hojab = Sheets("Hoja12").Name
Sheets(hoja).Select
filaini = 6
Cells(6, 1).Select
Selection.End(xlDown).Select
filafin = ActiveCell.Row
Range("A5:D15").Select
Range(Cells(filaini - 1, 1), Cells(filafin, 4)).Copy Destination:= _
Sheets(hojab).Range("A1")
Range("D:D").Select
Set RangoObj = Selection.Find(What:="TIPO PRODUCTO", _
After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
filades = RangoObj.Row + 2
Sheets(hojab).Select
Range("A1:D" & Rows.Count).End(xlUp).Select
Selection.Sort Key1:=Range("C1"), Order1:=xlDescending, _
Key2:=Range("A1"), Order2:=xlDescending, _
Key3:=Range("D1"), Order3:=xlDescending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
ufila = Range("A" & Rows.Count).End(xlUp).Row
una = 1
totbulto = 0
For i = 2 To ufila
If una = 1 Then
largo = Cells(i, 3)
ancho = Cells(i, 4)
lote = Cells(i, 1)
bulto = Cells(i, 2)
una = 2
End If
largo_n = Cells(i, 3)
ancho_n = Cells(i, 4)
lote_n = Cells(i, 1)
bulto_n = Cells(i, 2)
If largo = largo_n And ancho = ancho_n And lote = lote_n Then
totbulto = totbulto + 1
Else
Sheets(hoja).Cells(filades, 1) = Sheets(hoja).Cells(2, 2) 'no.pedido
Sheets(hoja).Cells(filades, 2) = Sheets(hoja).Cells(1, 2) 'cliente
Sheets(hoja).Cells(filades, 4) = totbulto
Sheets(hoja).Cells(filades, 5) = largo
Sheets(hoja).Cells(filades, 6) = ancho
Sheets(hoja).Cells(filades, 8) = lote
filades = filades + 1
totbulto = 1
End If
largo = largo_n
ancho = ancho_n
lote = lote_n
bulto = bulto_n
Next
'datos finales
Sheets(hoja).Cells(filades, 1) = Sheets(hoja).Cells(2, 2) 'no.pedido
Sheets(hoja).Cells(filades, 2) = Sheets(hoja).Cells(1, 2) 'cliente
Sheets(hoja).Cells(filades, 4) = totbulto
Sheets(hoja).Cells(filades, 5) = largo
Sheets(hoja).Cells(filades, 6) = ancho
Sheets(hoja).Cells(filades, 8) = lote
Application.DisplayAlerts = False
Worksheets(hojab).Delete
Application.DisplayAlerts = True
Sheets(hoja).Select
End Sub
Saludos.Dam
Si es lo que necesitas.