Macro para realizar un resumen anual
Hola experto:
Necesito de tu ayuda. Tengo cuatro libros y cada libro tengo 3 hojas donde voy registrando en cada una de ellas las ventas del mes; esto es en dentro de las filas 10 a la 60. De vez en cuando se van agregando datos a esas ventas. En la columna A esta el numero de factura y el cual es consecutivo. Lo que necesito es una macro que lleve todos los datos de la la fila si es que la columna A tiene datos a una libro que sea el resuemen anual y que este actualizado.
Espero haber sido lo suficientemente claro para que puedas ayudarme.
Gracias!
Necesito de tu ayuda. Tengo cuatro libros y cada libro tengo 3 hojas donde voy registrando en cada una de ellas las ventas del mes; esto es en dentro de las filas 10 a la 60. De vez en cuando se van agregando datos a esas ventas. En la columna A esta el numero de factura y el cual es consecutivo. Lo que necesito es una macro que lleve todos los datos de la la fila si es que la columna A tiene datos a una libro que sea el resuemen anual y que este actualizado.
Espero haber sido lo suficientemente claro para que puedas ayudarme.
Gracias!
Respuesta de blooddragon
1
Aquí son dos cosas el problema es que en tus tres libros deberás marcar las facturas ya copiadas para que el programa no las tomes en cuenta 2 de momento me encuentro un poco apretado con el trabajo te paso este código con algunas modificaciones puede funcionar para lo que necesitas básicamente barre una hoja determinada y busca si es el valor mayor a 85 si es así entonces te copia el valor en otra celda de otra hoja
Sub copia_valores()
On Error GoTo EH
Dim NHoja As String
Dim Val As Variant
Dim i, j As Integer
ActiveWorkbook.Sheets("Hoja1").Activate
ActiveSheet.Cells(1, 1).Activate
i = 1
While ActiveCell.Value <> ""
i = i + 1
If ActiveCell.Value > 85 Then
ActiveCell.Select
Selection.Copy
Sheets("Hoja3").Select
j = ActiveCell.Row
While ActiveCell.Value <> ""
j = j + 1
ActiveSheet.Cells(j, 1). Activate
Wend 'While ActiveCell <> ""
ActiveSheet.Paste
ActiveWorkbook.Sheets("Hoja1").Activate
End If 'If ActiveCell.Validation > 85 Then
ActiveSheet.Cells(i, 1).Activate
Wend 'While ActiveCell.Value <> ""
Exit Sub
EH:
Select Case Err.Number
Case 1004:
Resume Next
Case Else:
MsgBox Err.Number & "-" & Err.Description
End Select
End Sub
Sub copia_valores()
On Error GoTo EH
Dim NHoja As String
Dim Val As Variant
Dim i, j As Integer
ActiveWorkbook.Sheets("Hoja1").Activate
ActiveSheet.Cells(1, 1).Activate
i = 1
While ActiveCell.Value <> ""
i = i + 1
If ActiveCell.Value > 85 Then
ActiveCell.Select
Selection.Copy
Sheets("Hoja3").Select
j = ActiveCell.Row
While ActiveCell.Value <> ""
j = j + 1
ActiveSheet.Cells(j, 1). Activate
Wend 'While ActiveCell <> ""
ActiveSheet.Paste
ActiveWorkbook.Sheets("Hoja1").Activate
End If 'If ActiveCell.Validation > 85 Then
ActiveSheet.Cells(i, 1).Activate
Wend 'While ActiveCell.Value <> ""
Exit Sub
EH:
Select Case Err.Number
Case 1004:
Resume Next
Case Else:
MsgBox Err.Number & "-" & Err.Description
End Select
End Sub
