¿Qué cambiar de esta macro?

¿Qué tal como les va? Acudo a alguno de ustedes que me pueda dar una manito para encontrar el cambio que necesita esta macro y así lograr la función que deseo.. Paso a explicar y espero se entienda

Tengo una hoja ventas donde cargo datos, al presionar el botón guardar, automáticamente me guarda la operación de esa hoja.. Ahora, hay cuatro campos que me repite los datos a la hora del guardado, las primeras 4 columnas si ven la foto serian B11 C11 D11 E11 los datos de esa columna se repiten y estoy necesitando que sean guardados una vez tal cual están en la hoja ventas... De lograr esto pienso que también hay que modificar algo para que al próximo guardado no me sobrescriba datos anteriores ya que dadarian celdas vacías.. ¿puede ser? Dejo la secuencia de la macro si es posible me podrían indicar el los cambios que debería hacer a la macro, mis conocimientos en esto son escasos sinceramente, igual con cambios y con lo poco que entiendo logre hacer una sistema útil para mi actividad pero para esto que pido ya mis conocimientos ya no me sirven.. Muchas gracias por su tiempo. Un saludos grande.

dejo la macro

Sub copiar()
Dim fil, col As Integer
Dim x, y, z As Integer
Dim encab(4)
Dim cuerpo()

Sheets("Ventas").Select
Sheets("VENTAS").Range("B11") = Range("b11") + 1
Range("F11").Select
fil = 0
col = 18
Do While Not IsEmpty(ActiveCell)
fil = fil + 1
ActiveCell.Offset(1, 0).Select
Loop
Range("F11").Select
For x = 1 To 4
encab(x) = ActiveCell.Offset(0, x - 5).Value
Next
ReDim cuerpo(fil, col)
Do While Not IsEmpty(ActiveCell)
For x = 1 To fil
For y = 1 To col
cuerpo(x, y) = ActiveCell.Offset(0, y - 1).Value
Next
ActiveCell.Offset(1, 0).Select
Next
Loop
Sheets("REGISTRO").Select
Range("B166").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
For x = 1 To fil
For z = 1 To 4
ActiveCell.Offset(0, z - 1).Value = encab(z)
Next
For y = 1 To col
ActiveCell.Offset(0, y + 3).Value = cuerpo(x, y)
Next
ActiveCell.Offset(1, 0).Select
Next

End Sub

'

1 Respuesta

Respuesta

Te anexo una nueva macro

Sub copiar2()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Ventas")
    Set h2 = Sheets("REGISTRO")
    h1.Range("B11") = h1.Range("B11") + 1
    '
    u1 = 11
    Do While Not IsEmpty(h1.Cells(u1, "F"))
        u1 = u1 + 1
    Loop
    u1 = u1 - 1                                         'ultima fila con datos de ventas
    u2 = h2.Range("F" & Rows.Count).End(xlUp).Row + 1   'ultima fila con datos de regitro
    '
    H1. Range("B11:E11"). Copy 'copia encabezado
 h2.Range("B" & u2). PasteSpecial xlValues
 h1.Range("F11:P" & u1). Copy 'copia cuerpo
 h2.Range("F" & u2). PasteSpecial xlValues
 h1. Range("Q11:w11"). Copy 'copia totales
 h2.Range("Q" & u2). PasteSpecial xlValues
    Application.ScreenUpdating = True
    MsgBox "Registros copiados"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas