Macro para ordenar datos por nombre y después sumar los montos para sacar totales por nombre
Me podrían ayudar por favor tengo una base de datos la cual necesito acomodar por orden alfabético y después sacar un subtotal del monto por cada cambio en el nombre me ayudan a hacerlo automático por favor mando ejemplo de mi hoja
Original
Acomodado y con totales
Respuesta de Adriel Ortiz Mangia
email: [email protected]
[Hola
Te paso la macro
Sub Ordenar_Totalizar()
'Fuente Dante Amor
'Act. Adriel Ortiz
'
Application.ScreenUpdating = False
Set h1 = Sheets("BASE JUNIO")
'
u = h1.Range("A" & Rows.Count).End(xlUp).Row
With h1.Sort
.SortFields.Clear
.SortFields.Add Key:=h1.Range("C3:C" & u), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange h1.Range("A2:G" & u)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'
c1 = "C" 'columna de nombres
c2 = "D" 'columna de importes
u = h1.Range(c1 & Rows.Count).End(xlUp).Row
fin = u
ant = h1.Cells(u, c1)
tot = 0
For i = u To 2 Step -1
If h1.Cells(i, c1) <> ant Then
h1.Rows(fin + 1 & ":" & fin + 2).Insert
h1.Cells(fin + 1, c2) = tot
h1.Cells(fin + 1, c1) = "Total " & ant
h1.Cells(fin + 1, c1).Font.Bold = True
tot = 0
fin = i
End If
tot = tot + Val(h1.Cells(i, c2))
ant = h1.Cells(i, c1)
Next
'
Application.ScreenUpdating = True
MsgBox "Fin"
End SubValora la respuesta para finalizar saludos!
