JSDJSD

No

Intenta subir tu archivo

Elimina las partes innecesarias del archivo y súbelo

Sube tu archivo

Sub Agrupar(): Application.ScreenUpdating = False Hoja3.Cells.Clear With Hoja1 Set tbl = .ListObjects("Tabla1") Set Rng = tbl.Range tbl.Unlist Set tbl = Nothing uf = .Range("A" & Rows.Count).End(xlUp).Row .Range("A1:H" & uf).Copy Destination:=Hoja3.Range("A1") Set tbl = .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes) tbl.Name = "Tabla1" End With With Hoja3 .Range("A:H").Sort Key1:=.Columns("G"), Order1:=xlAscending, Header:=xlYes For X = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1 If Trim(.Range("G" & X)) = Trim(.Range("G" & X - 1)) Then .Range("C" & X - 1) = .Range("C" & X - 1) & "," & .Range("C" & X) .Range("D" & X - 1) = .Range("D" & X - 1) & "," & .Range("D" & X) .Range("E" & X - 1) = .Range("E" & X - 1) & "," & .Range("E" & X) .Range("F" & X - 1) = .Range("F" & X - 1) & "," & .Range("F" & X) .Rows(X).Delete End If Next .Range("A1", "H" & .Range("A" & .Rows.Count).End(xlUp).Row).Rows.AutoFit .Range("A1", "H" & .Range("A" & .Rows.Count).End(xlUp).Row).Columns.AutoFit End With End Sub BD GETAFE.xlsm

A ver si es esto lo que buscas

Sube tu archivo

Pruébalo y comenta si es lo que buscabas

Private Sub CommandButton1_Click(): Application.ScreenUpdating = False With Hoja2 If .Range("A" & .Rows.Count).End(xlUp).Row > 1 Then .Range("A2:J" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents End If End With With Hoja1 ufh1 = .Range("J" & .Rows.Count).End(xlUp).Row For Each buscado In .Range("A3:A" & ufh1) ufh2 = Hoja2.Range("A" & Hoja2.Rows.Count).End(xlUp).Row + 1 Select Case buscado.Value Case "cliente:" cliente = .Cells(buscado.Row, 2).Value proyecto = .Cells(buscado.Row, 4).Value orden = .Cells(buscado.Row, 8).Value empaque = .Cells(buscado.Row, 11).Value Case "LOTE" i = 0 Do Until .Cells(buscado.Row + i + 2, 1).Value = "TOTALES" And .Cells(buscado.Row + i + 2, 2).Value = "" Hoja2.Cells(ufh2 + i, 1).Value = cliente Hoja2.Cells(ufh2 + i, 2).Value = proyecto Hoja2.Cells(ufh2 + i, 3).Value = orden Hoja2.Cells(ufh2 + i, 9).Value = empaque Hoja2.Cells(ufh2 + i, 4).Value = .Cells(buscado.Row + 2 + i, 1).Value Hoja2.Cells(ufh2 + i, 5).Value = .Cells(buscado.Row + 2 + i, 2).Value Hoja2.Cells(ufh2 + i, 6).Value = .Cells(buscado.Row + 2 + i, 3).Value Hoja2.Cells(ufh2 + i, 7).Value = .Cells(buscado.Row + 2 + i, 5).Value Hoja2.Cells(ufh2 + i, 8).Value = .Cells(buscado.Row + 2 + i, 7).Value i = i + 1 Loop Case "Fecha Empaque" fecha = .Cells(buscado.Row, 10).Value i = 1 Do Until Hoja2.Cells(ufh2 - i, 10).Value <> "" Or ufh2 - i < 2 Hoja2.Cells(ufh2 - i, 10).Value = fecha i = i + 1 Loop End Select Next buscado End With End Sub informe empaque.xlsm

Bueno, aquí tienes el código modificado

Correcto, no tuve en cuenta los datos subidos, solamente me fije en los dos primeros clientes, en cuanto pueda te lo modifico

Aquí tienes el archivo Prueba de 2 macros en hoja.xlsm

Declara la variable como te muestro y lo tiene funcionando

Cual es el problema ?

Sub IncrementarValor() If TypeName(Selection) = "Range" And Selection.Cells.Count = 1 Then Set cel = Selection If Not IsEmpty(cel.Value) Then valor = cel.Value cel.Value = valor + cel.Offset(0, -5).Value Else MsgBox "La celda seleccionada está vacía.", vbExclamation End If Else MsgBox "Por favor, selecciona una única celda.", vbExclamation End If End Sub Libro1.xlsm

No se si será lo que necesitas, ejecuta la macro con Control + n

Sube tu archivo

Private Sub CommandButton1_Click(): Application.ScreenUpdating = False With Hoja2 If .Range("A" & Rows.Count).End(xlUp).Row > 1 Then .Range("A2:J" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents End If End With With Hoja1 ufh1 = .Range("J" & Rows.Count).End(xlUp).Row For Each buscado In .Range("A3:K" & ufh1) ufh2 = Hoja2.Range("A" & Rows.Count).End(xlUp).Row Select Case buscado.Value Case "cliente:" Hoja2.Cells(ufh2 + 1, 1).Value = .Cells(buscado.Row, 2).Value Case "Proyecto:" Hoja2.Cells(ufh2, 2).Value = .Cells(buscado.Row, 4).Value Case "Orden:" Hoja2.Cells(ufh2, 3).Value = .Cells(buscado.Row, 8).Value Case "Empaque #:" Hoja2.Cells(ufh2, 9).Value = .Cells(buscado.Row, 11).Value Case "LOTE" Hoja2.Cells(ufh2, 4).Value = .Cells(buscado.Row + 2, 1).Value Case "ITEM" Hoja2.Cells(ufh2, 5).Value = .Cells(buscado.Row + 2, 2).Value Case "CANTIDAD" Hoja2.Cells(ufh2, 6).Value = .Cells(buscado.Row + 2, 3).Value Case "ANCHO" Hoja2.Cells(ufh2, 7).Value = .Cells(buscado.Row + 2, 5).Value Case "LARGO" Hoja2.Cells(ufh2, 8).Value = .Cells(buscado.Row + 2, 7).Value Case "Fecha Empaque" Hoja2.Cells(ufh2, 10).Value = .Cells(buscado.Row, 10).Value End Select Next buscado End With End Sub informe empaque.xlsm

Prueba y comenta

Prueba y comenta Private Sub buscar_Change() material.Clear If buscar = "" Then material.List = Hoja2.Range("C3:C" & Hoja2.Range("C" & Rows.Count).End(xlUp).Row).Value Exit Sub End If For x = 3 To Hoja2.Range("C" & Rows.Count).End(xlUp).Row If InStr(1, UCase(Hoja2.Range("C" & x)), UCase(buscar)) > 0 Then material.AddItem Hoja2.Range("C" & x) End If Next End Sub

Luego lo intento

El archivo Libro1 (3).xlsm

Te dejo otra opción