Macro complicada (buscar dato + pegar en fila)

5 envíos / 0 nuevos
Último envío
marc.rago
Imagen de marc.rago
Offline
última acción: Hace 8 meses 1 semana
alta: 04/06/2018 - 15:24
Puntos: 45
Macro complicada (buscar dato + pegar en fila)

Hola,

Soy nuevo en este mundo y pese a que he buscado y buscado no encuentro solución.

En concreto, necesito una macro que haga lo siguiente:

1. Copie las líneas 2-11 de la Hoja2

2. En la Hoja1, busque en la columna B la primera celda con el valor que hay en la celda U1.

2. Seleccione la fila donde se encuentra esa celda e inserte 10 líneas debajo.

3. Pegue el contenido copiado en las líneas recién creadas.

 

A ver si alguien puede ayudarme...

Gracias y un saludo!

Etiquetas: 

Cron
Imagen de Cron
Offline
última acción: Hace 31 mins
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntosNivel 5 - 4000 puntos
alta: 23/06/2010 - 12:30
Puntos: 11670
A ver, por partes.Puedes

A ver, por partes.

Puedes utilizar las funciones Range.copy y Range.paste para copiar y pegar. La otra opción es crearte una estructura en memoria donde copiar los datos de las líneas 2-11 de la Hoja 2 y luego pegarlo en su sitio en la Hoja1. A mí me gusta mucho más esta segunda opción.

Por lo tanto, lo primero sería copiar los datos en memoria:

dim matriz as variant
matriz = sheets("Hoja2").cells(2,1).resize(10,1).entirerow

Una vez hecho esto, debemos buscar la celda, y eso se puede hacer con find:

dim celda as range
set celda = sheets("Hoja1").cells(1,2).entirecolumn.find(cells(1, 21).value).offset(1,0)

Con esto estamos tomando la celda (1,2) - que es la celda B1 -, seleccionando la columna entera y buscando dentro de esa selección el valor que hay en la celda U1. Una vez encontrado, nos desplazamos una celda hacia abajo, y esa celda la almacenamos en nuestra variable celda, que es de tipo range.

Una vez hecho esto, tomamos esa celda, la estiramos 10 celdas hacia abajo y seleccionamos las filas enteras. Así podremos insertar correctamente las 10 filas que queremos. Esto se puede hacer así:

celda.resize(10,1).entirerow.select
selection
.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Una vez hecho esto, ya solo queda pegar los datos en el hueco que nos queda:

selection = matriz

Todo junto queda algo así como:

Sub Macro1()

Dim celda As Range
Dim matriz As Variant
matriz = Sheets("Hoja2").Cells(2, 1).Resize(10, 1).EntireRow
Set celda = Cells(1, 1).EntireColumn.Find(Cells(1, 21).Value).Offset(1, 0)
celda.Resize(10, 1).EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection = matriz

End Sub

 

Un saludo

marc.rago
Imagen de marc.rago
Offline
última acción: Hace 8 meses 1 semana
alta: 04/06/2018 - 15:24
Puntos: 45
Gracias!

Muchas gracias Cron!

Funciona a la perfección.

Solo una pequeña cosa. Al crear la estructura de memoria solo guarda valores, y de hecho me va bien que así sea.

Pero hay alguna forma de pegar el formato de las líneas de origen (Hoja2) en las filas insertadas en la Hoja1?

Muchas gracias.

Un saludo!

Cron
Imagen de Cron
Offline
última acción: Hace 31 mins
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntosNivel 5 - 4000 puntos
alta: 23/06/2010 - 12:30
Puntos: 11670
Claro!!Puedes hacer dos cosas

Claro!!

Puedes hacer dos cosas. Si el formato es simple (por ejemplo, solo el color de la celda o tipo de letra y negrita, o algo así), puedes copiarlo en variables y llevarlo al otro lado. Lo mismo si el formato depende del valor.

La otra opción, más sencilla, es la que te comentaba en la primera respuesta: copy & paste. Podríamos modificar un poco la macro para que haga esto:

Sub Macro1()

Dim celda As Range
Sheets("Hoja2").Cells(2, 1).Resize(10, 1).EntireRow.Copy
Set celda = Cells(1, 1).EntireColumn.Find(Cells(1, 21).Value).Offset(1, 0)
celda.Resize(10, 1).EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

End Sub 

 

Un saludo

marc.rago
Imagen de marc.rago
Offline
última acción: Hace 8 meses 1 semana
alta: 04/06/2018 - 15:24
Puntos: 45
Gracias 2!

Genial, muchas gracias!

Saludos