Macros que pueda copiar datos de Nhojas con un mismo formato a una hoja distintay ordenarlas por filas, solo celdas especificas.
Resulta que tengo un archivo con varias hojas que son formatos de compra, quisiera saber si existe una macro que pueda copiar algunas variables del formato de compra. Como son por ejemplo: El el numero de compra, proveedor, la lista de materiales comprado, fecha del mismo y el importe sumado.
Estaré muy agradecido con quien me pueda brindar un apoyo
1 respuesta
¡Gracias!
Inmediatamente te las enviare mi estimada
Nuevamente Gracias de Antemano
Te estoy devolviendo el libro ya ejecutado.
La macro se encuentra en un módulo ... podés llamarla desde menú macros, con botón, atajo de teclado, etc... estos temas los tengo explicados en la sección Macros de mi sitio.
Lo que hace es limpiar la hoja desde fila 5 hasta la última ocupada y luego le asigna el formato bordes a cada grupo.
Sub resumiendo()
'x Elsamatilde
'recorre la col b de hoja resumen buscando hoja PO
Sheets("hoja resumen").Select
Application.ScreenUpdating = False
ini = 5
b = Range("B" & Rows.Count).End(xlUp).Row
e = Range("E" & Rows.Count).End(xlUp).Row
maxi = Application.WorksheetFunction.Max(b, e)
'se busca el fin de filas ocupadas para limpiar, quitar borde y autoajustar
Range("B5:M" & maxi).Select
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.ClearContents
Rows("5:" & maxi).Rows.AutoFit
For i = 1 To 29 'ajustar si habrá más hojas
hojita = "PO " & i
For Each sh In Sheets
If sh.Name = hojita Then esta = 1
Next sh
If esta = 0 Then GoTo sigoconotra
Set hox = Sheets(hojita)
'completa hoja resumen con datos de PO
Range("B" & ini) = i 'nro PO
Range("C" & ini) = hox.[E8]
Range("D" & ini) = hox.[E9]
Range("E" & ini) = hox.[E15] 'descripc
Range("F" & ini) = hox.[D15] 'unidad
Range("G" & ini) = hox.[C15] 'cant
Range("H" & ini) = hox.[F15] 'precio unit
Range("I" & ini) = hox.[G15] 'importe
Range("M" & ini) = hox.[G7] 'fecha
filx = 16: fily = ini
While hox.Range("E" & filx) <> "" And hox.Range("F" & filx) <> ""
fily = fily + 1
Range("E" & fily) = hox.Range("E" & filx) '1er descripc
Range("F" & fily) = hox.Range("D" & filx) 'unidad
Range("G" & fily) = hox.Range("C" & filx) 'cant
Range("H" & fily) = hox.Range("F" & filx) 'precio unit
Range("I" & fily) = hox.Range("G" & filx) 'importe
filx = filx + 1
Wend
'terminaron las descripciones, busco el dcto
While hox.Range("F" & filx) = "" And hox.Range("G" & filx) = ""
filx = filx + 1
Wend
If UCase(Trim(hox.Range("E" & filx))) = "DESCUENTO" Then
Range("J" & ini) = hox.Range("G" & filx)
filx = filx + 1
End If
'busca el texto SUBTOTAL
While UCase(Left(hox.Range("F" & filx), 8)) <> "SUBTOTAL"
filx = filx + 1
Wend
Range("K" & ini) = hox.Range("G" & filx) 'subtotal
Range("L" & ini) = hox.Range("G" & filx + 2) 'total
Range("B" & ini & ":M" & fily).Select
Call aplicaBordesRango
ini = fily + 1
sigoconotra:
Next i
MsgBox "Fin del proceso resumen.", , "INFORMACIÓN"
End Sub
Muchísimas ¡Gracias!
Justamente era lo que buscaba gracias por tu apoyo y por tu tiempo eres toda experto en Excel-Macros.
Estaré eternamente agradecido..
Saludos a la distancia..!
