Botón que copie dos veces los mismos datos

.06.03.17

Buenas tardes, Hugo

Las instrucciones que mencionas:

...

ActiveCell.Offset(0, 1).Value = Piloto
ActiveCell.Offset(0, 2).Value = Fecha
ActiveCell.Offset(0, 3).Value = Ruta
ActiveCell.Offset(0, 4).Value = Monto_dev
ActiveCell.Offset(0, 5).Value = Devoluciones
ActiveCell.Offset(0, 6).Value = Facturado
ActiveCell.Offset(0, 7).Value = Facturas

Efectivamente, vuelven a escribir -en la misma fila- y en la misma columna lo que ya se habia escrito con las primeras instrucciones.

Si, lo que deseas hacer es que repita esos valores en la fila siguiente deberías reemplazarlas por estas

Sub Copia2()
ActiveSheet.Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Activate
ActiveCell.Offset(0, 0).Value = Catalogo
ActiveCell.Offset(0, 1).Value = Piloto
ActiveCell.Offset(0, 2).Value = Fecha
ActiveCell.Offset(0, 3).Value = Ruta
ActiveCell.Offset(0, 4).Value = Monto_dev
ActiveCell.Offset(0, 5).Value = Devoluciones
ActiveCell.Offset(0, 6).Value = Facturado
ActiveCell.Offset(0, 7).Value = Facturas
ActiveCell.Offset(1, 1).Value = Piloto
ActiveCell.Offset(1, 2).Value = Fecha
ActiveCell.Offset(1, 3).Value = Ruta
ActiveCell.Offset(1, 4).Value = Monto_dev
ActiveCell.Offset(1, 5).Value = Devoluciones
ActiveCell.Offset(1, 6).Value = Facturado
ActiveCell.Offset(1, 7).Value = Facturas
End Sub

.

y lo único que va a variar es nombre y el resto sigue igual 

.

Ok, entonces, la búsqueda de la última línea debe hacerla sobre la segunda columna, no la primera.

En tal caso la rutina debería ser esta:

Sub Copia2()
    ActiveSheet.Range("B" & Rows.Count).End(xlUp).Offset(1, -1).Activate
        ActiveCell.Offset(0, 0).Value = Catalogo
        ActiveCell.Offset(0, 1).Value = Piloto
        ActiveCell.Offset(0, 2).Value = Fecha
        ActiveCell.Offset(0, 3).Value = Ruta
        ActiveCell.Offset(0, 4).Value = Monto_dev
        ActiveCell.Offset(0, 5).Value = Devoluciones
        ActiveCell.Offset(0, 6).Value = Facturado
        ActiveCell.Offset(0, 7).Value = Facturas
        ActiveCell.Offset(1, 1).Value = Piloto
        ActiveCell.Offset(1, 2).Value = Fecha
        ActiveCell.Offset(1, 3).Value = Ruta
        ActiveCell.Offset(1, 4).Value = Monto_dev
        ActiveCell.Offset(1, 5).Value = Devoluciones
        ActiveCell.Offset(1, 6).Value = Facturado
        ActiveCell.Offset(1, 7).Value = Facturas
End Sub

Así no deberías tener problemas.

Saludos

Fer

.

Excelente, solo que en D71 va Juan Perez  y en H71 Pedro López  el resto sigue igual

.

OK, pero en la imagen que pasaste están en la misma columna y en distinta fila.

Mientras que D71 y H71 son distintas columnas y misma fila.

Según eso, variaría la codificación de la rutina VBA.

Saludos

Fer

.

Te envió el ej. Todo es igual lo único que Juan Perez es Piloto y Pedro Lopez su auxiliar los datos son los mismos lo que varia es el nombre del Piloto y Auxiliar:

Sub Rectángulo_Haga_clic_en()
Dim Catalogo, Fecha, Devoluciones, Facturado, Ruta As String
Dim Facturas As Byte
Catalogo = Range("C4").Value
Fecha = Range("H3").Value
Facturas = Range("H5").Value
Devoluciones = Range("G46").Value
Facturado = Range("C8").Value
Ruta = Range("F20").Value
Monto_dev = Range("H47").Value
Piloto = Range("D71").Value
Auxiliar = Range("H71").Value
Application.Workbooks("DEVOLUCIONESEJE.xlsx").Activate
ActiveWorkbook.Sheets("DEVOLUCIONES").Activate

ActiveSheet.Range("B" & Rows.Count).End(xlUp).Offset(1, -1).Activate
ActiveCell.Offset(0, 0).Value = Catalogo
ActiveCell.Offset(0, 1).Value = Piloto
ActiveCell.Offset(0, 2).Value = Fecha
ActiveCell.Offset(0, 3).Value = Ruta
ActiveCell.Offset(0, 4).Value = Monto_dev
ActiveCell.Offset(0, 5).Value = Devoluciones
ActiveCell.Offset(0, 6).Value = Facturado
ActiveCell.Offset(0, 7).Value = Facturas
ActiveCell.Offset(1, 1).Value = Piloto
ActiveCell.Offset(1, 2).Value = Fecha
ActiveCell.Offset(1, 3).Value = Ruta
ActiveCell.Offset(1, 4).Value = Monto_dev
ActiveCell.Offset(1, 5).Value = Devoluciones
ActiveCell.Offset(1, 6).Value = Facturado
ActiveCell.Offset(1, 7).Value = Facturas

ActiveWorkbook.Sabe

End Sub

.

Ok. Entiendo

Tomas datos de una hoja con determinada distribución y los llevas a una base de datos en forma ordenada.

Entre ellos, no está el dato del Auxiliar.

Saludos

Fer

.

Todo esta bien, los datos que me duplica, lo que no quiero que me duplique es el piloto y auxiliar que están en celdas distintas

.

Buenos días, Hugo

En la siguiente versión anulé la línea que repite el nombre del Piloto en la segunda línea. El auxiliar no estaba previsto que se cargue en la base dentro del código que me pasaste originalmente.

Dejé una línea que lo haga en lugar del nombre del piloto que anulé en la línea anterior.

Sí no fuera lo que buscas también puedes anularla borrandola o, simplemente, colocandole un apóstrofo al inicio de la instrucción.

Lo que realmente no entiendo es por qué calificaste prontamente como excelente a la otra respuesta si no había resuelto tu problema.

Como fuere, aquí está la rutina modificada:

Sub Rectángulo_Haga_clic_en()
Dim Catalogo, Fecha, Devoluciones, Facturado, Ruta As String
Dim Facturas As Byte
Catalogo = Range("C4").Value
Fecha = Range("H3").Value
Facturas = Range("H5").Value
Devoluciones = Range("G46").Value
Facturado = Range("C8").Value
Ruta = Range("F20").Value
Monto_dev = Range("H47").Value
Piloto = Range("D71").Value
Auxiliar = Range("H71").Value
Application.Workbooks("DEVOLUCIONESEJE.xlsx").Activate
ActiveWorkbook.Sheets("DEVOLUCIONES").Activate
ActiveSheet.Range("B" & Rows.Count).End(xlUp).Offset(1, -1).Activate
ActiveCell.Offset(0, 0).Value = Catalogo
ActiveCell.Offset(0, 1).Value = Piloto
ActiveCell.Offset(0, 2).Value = Fecha
ActiveCell.Offset(0, 3).Value = Ruta
ActiveCell.Offset(0, 4).Value = Monto_dev
ActiveCell.Offset(0, 5).Value = Devoluciones
ActiveCell.Offset(0, 6).Value = Facturado
ActiveCell.Offset(0, 7).Value = Facturas
'  
'ActiveCell.Offset(1, 1).Value = Piloto '<<< Línea anulada para que no repita el piloto  
'
ActiveCell.Offset(1, 1).Value = Auxiliar '<<< anulala si no quieres que coloque el Auxiliar debajo del Piloto  
'  
ActiveCell.Offset(1, 2).Value = Fecha
ActiveCell.Offset(1, 3).Value = Ruta
ActiveCell.Offset(1, 4).Value = Monto_dev
ActiveCell.Offset(1, 5).Value = Devoluciones
ActiveCell.Offset(1, 6).Value = Facturado
ActiveCell.Offset(1, 7).Value = Facturas
ActiveWorkbook.Sabe
End Sub

Espero que sea lo que buscas.

Un abrazo

Fer

.

¡Gracias!  Fer quedo excelente te agradezco, por tu tiempo prestado todo funciona bien, nuevamente gracias 

.

Me alegro de que te haya funcionado.

Un placer poder ayudarte, Hugo

Abrazo

Fer

.

Siempre en el mismo tema Fer, solo que ahora quiero agregar una línea más ej. auxiliar2 y logre hacerlo, pero cuando no ingrese al auxiliar2 no me tire la línea de auxiliar2.

Gracias