¿Macro para comparar, insertar filas y sumar?
Si me pudieran ayudar con una macro que me compare información de hojas y me añada su cantidad en una hoja total. Por ejemplo: en la hoja 1 tengo una hoja total (que en inicio esta vacia) donde se suman las demás hojas parciales (pudiendo variar la cantidad de hojas "parciales"), si por ejemplo en la hoja 2 tengo un material A y su respectiva cantidad, en la hoja 3 un material B y su cantidad y en la hoja 4 material A y B y sus cantidades, la macro al ejecutarse primero evaluaría la hoja 2 e insertaría una fila en la cual añadiría el material A en una lista y su cantidad, posteriormente evaluaría la hoja 3 e hiciera lo mismo, cuando llegue a la hoja 4 la evaluaría y al "ver" que ya existen los materiales solo sumaria su cantidad a la que había anteriormente.
Te anexo la macro.
Solamente cambia en la macro los siguientes datos por tus datos
hoja = "Total" 'nombre de la hoja de totales colm = "A" 'columna de materiales colc = "B" 'columna de cantidades fila = 2 'fila donde inician los materiales
La macro completa:
Sub SumarMateriales() 'Por.Dante Amor hoja = "Total" 'nombre de la hoja de totales colm = "A" 'columna de materiales colc = "B" 'columna de cantidades fila = 2 'fila donde inician los materiales ' Set h1 = Sheets(hoja) For Each h In Sheets Select Case UCase(h.Name) Case UCase(hoja) Case Else For i = fila To h.Range(colm & Rows.Count).End(xlUp).Row Set b = h1.Columns(colm).Find(h.Cells(i, colm), lookat:=xlWhole) If Not b Is Nothing Then h1.Cells(b.Row, colc) = h1.Cells(b.Row, colc) + Val(h.Cells(i, colc)) Else u = h1.Range(colm & Rows.Count).End(xlUp).Row + 1 h1.Cells(u, colm) = h.Cells(i, colm) h1.Cells(u, colc) = Val(h.Cells(i, colc)) End If Next End Select Next MsgBox "Fin totalizar materiales" End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Muchas gracias podría funcionar, pero en el libro que quiero implementar tiene ciertas características, no se si me pudiera dar un correo para poderle enviar el libro excel en el cual quiero la macro.
Envíame tu archivo y me explicas con colores y con ejemplos lo que necesitas.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Rafael Alejo” y el título de esta pregunta.
Ya le envíe el documento, quisiera conservar las fórmulas que se encuentran en las celdas de amarillo al momento de aumentar los materiales, de seguro al abrirlo podrá entender mejor lo que quiero que la macro realice.
Ya le envié otros tres documentos como ejemplos. Quisiera que abra primero el documento llamado "pruebaago" puesto que tiene una explicación de lo que quiero que la macro realice.
Te anexo la macro
Sub NuevoAjuste()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Ajuste Total")
For Each h In Sheets
Select Case h.Name
Case h1.Name, "Listado items"
Case Else
i = 13
Do While h.Cells(i, "D") <> ""
witem = h.Cells(i, "D")
Set b = h1.Columns("A").Find(witem, lookat:=xlWhole)
If b Is Nothing Then
h1.Rows("10:10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
h1.Range("C9:F9").Copy
h1.Range("C10").PasteSpecial Paste:=xlPasteFormulas
h1.Range("A10") = witem
h1.Range("B10") = h.Cells(i, "E")
h1.Range("E10") = h.Cells(i, "H")
Else
h1.Cells(b.Row, "E") = h1.Cells(b.Row, "E") + h.Cells(i, "H")
End If
i = i + 1
Loop
End Select
Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
