Macro para añadir datos de una tabla a otra

Estoy intentando pasar los datos que voy introduciendo en un formulario de una hoja a una base de datos (tabla) en la hoja siguiente.

El macro que utilizo es este:

Range("C5").Select
Sheets("Datos").Select
Rows("2:2").Select
Sheets("Formulario").Select
Range("C5, C6, C7, C8, C9, C10, C11, C12, C13, C14, C15").Select
Selection.Copy
Sheets("Datos").Select
Range("A:L").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Sheets("Formulari").Range("C5, C6, C7, C8, C9, C10, C11, C12, C13, C14, C15").Value = ""
End Sub

El problema lo tengo en los comandos que en negrita. Necesito poner un rango que me permita ir introduciendo los datos de la primera tabla y que se copien en la primera fila de la base de datos, luego al introducir otros que se copien en la segunda fila, luego a la tercera, etc.

Por ejemplo, si pongo de rango Range("A2:L2") me sirve para la primera fila, pero al volver a rellenar el formulario se me borra lo que había introducido y se sustituye por la nueva información.

No sé si me habré explicado bien.

1 respuesta

Respuesta
1

Tienes mucho código innecesario, te lo simplifico:

No hace falta que vayas poniendo celda a celda si es un rango continuo vale con poner la primera y la ultima separadas con ":"

'Selecciona rango a copiar:

Sheets("Formulario"). Range("C5:C15"). Copy

El destino solo tienes que poner UNA celda, la primera del rango, pero quieres que cada vez sea en la siguiente línea. Entonces esa fila tendrá que ir cambiando.

Para ello primero buscaremos la ultima línea con datos usando esta instrucción:

uF = Cells(Rows.Count, "A").End(xlUp).Row

En este caso va a darnos el ultimo dato en la columna "A", si el dato que vas a poner en esa columna puede quedar en blanco algunas veces utiliza otra columna.

Ahora lo que quieres es que vaya añadiendo líneas al registro:

Sheets("Datos").Cells(uF+1, 2).PasteSpecial Paste:=xlPasteValues, Transpose:=True

O sea seria esto:

Sheets("Formulario"). Range("C5:C15"). Copy

uF = sheets("Datos"). Cells(Rows.Count, "A").End(xlUp). Row

Sheets("Datos").Cells(uF+1, 2).PasteSpecial Paste:=xlPasteValues, Transpose:=True

No me funcionó... 

Te escribo lo que he puesto ahora:

gravarmacro Macro 

'Selecciona rango a copiar:

   Sheets("Formulari").Range("C4:C15").Copy  

' Selecciona rango de destino

   Sheets("Dades").Select

   Range("A2:L2").Select

   uF = Sheets("Dades").Cells(Rows.Count, "A").End(xlUp).Row

Range("A2:L2").PasteSpecial Paste:=xlPasteValues, Transpose:=True

De la otra forma me daba error en el objeto. Aún así, con este código sigo teniendo el mismo problema; para añadir la primera fila de datos bien, pero al volver a rellenar la tabla de origen se me sustituyen los valores...

Muchísimas gracias por tu tiempo y perdón si no me explico bien y/o tardo en contestar.

He visto un error! Perdona, en la última linea.. ... Cells(uF+1, 2)... debe ser ... Cells(uF+1, 1)...

Sheets("Formulario"). Range("C5:C15"). Copy

uF = sheets("Datos"). Cells(Rows.Count, "A").End(xlUp). Row

Sheets("Datos").Cells(uF+1, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True

Insisto no puedes usar Paste en un rango distinto del que hayas usado en Copy, pero al poner una sola celda esta sera la primera y a partir de ahí pegará el rango necesario.

Revisa el texto, a mi me funciona perfectamente. No se si he puesto bien el nombre de las hojas.

Hola,

Ya me funciona, de verdad que muchísimas gracias, sólo me sucede lo siguiente: en la tabla de la hoja de Datos en la que tiene que pegarse la información ésta empieza a hacerlo al final de la tabla (fila 61) y no al principio (fila 2), ¿hay alguna forma de evitarlo? 

De todos modos muchas gracias por tu paciencia.

Con esta instrucción estas buscando la ultima fila (uF) que tiene algo escrito en la columna A.

Si debajo, o al final de la tabla tienes más cosas hay que cambiarla,

Puedes calmbiar la línea:

 uF = sheets("Datos"). Cells(Rows.Count, "A").End(xlUp). Row

Por estas otras:

uF=2

do until sheets("Datos").cells(uF,1)=""

uF=uF+1

loop

En este caso vas a buscar la primera fila vacía a partir de A2.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas