Macro para insertar líneas de acuerdo al numero de resultados en una búsqueda
Tengo una Macro con la cual realizo una búsqueda en otra hoja, y me trae devuelta resultados múltiples, como puedo hacer para que me inserte la cantidad de líneas correspondientes a los resultados encontrados, y no me reemplace los datos las líneas que tengo abajo.
1 Respuesta
¡Gracias!
Me he apoyado de una macro que has compartido hace tiempo,
Sub testNahun()
Set h1 = Sheets("En_Abierto")
Set h2 = Sheets("Planeamento COSTURA")
u2 = h2.Range("F" & Rows.Count).End(xlUp).Row
If u2 < 2 Then u2 = 2
h2.Range("D" & u2 & ":E" & u2).ClearContents
a = 4
a = 5
celda = "b4"
celda = "b5"
Set r = h1.Columns("b")
Set b = r.Find(h2.Range(celda), lookat:=xlWhole)
If Not b Is Nothing Then
ncell = b.Address
Do
h2.Range("b5").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove -- esta linea me marca un error que dice que la operacion no esta permitida que he intentado desplazar celdas.
' Sheets("h1").Cells(3, "G").Value = Sheets("h2").Cells("g").Value
h1.Range(h1.Cells(b.Row, "G"), h1.Cells(b.Row, "H")).Copy
h2.Cells(a, "D").PasteSpecial Paste:=xlValues
a = a + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
End Sub
Los datos los tengo consecutivos, lo que requiero es insertar entre líneas, por ejemplo en la línea 3 y 4, me debe traer los mismos datos, sin embargo los datos de la línea 4 reemplazan al resultado de la línea 3, lo que requiero es que entre estas líneas se inserten recorriendo la línea 4 hacia abajo
Espero puedas ayudarme, estoy comenzando en este tema de las macros y aun desconozco varias cosas.
Muchas gracias
Dante Amor
Pero no respondiste mi duda
¿A partir de cuál fila quieres insertar las nuevas filas?
Veo la macro, pero ya le hiciste cambios, entonces no entiendo cuál es el resultado que esperas.
Envíame un nuevo correo con tu archivo de excel y 3 hojas
La hoja1 será la hoja "En_Abierto"
La hoja2 será la hoja "Planeamento COSTURA" con los datos originales
La hoja3 será una copia de la hoja "Planeamento COSTURA_copia" pero me pones los datos que quieres como resultado.
En esa misma hoja3 me explicas con comentarios y con colores qué es lo que hiciste.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Nahun Lopez” y el título de esta pregunta.
¡Gracias! Dante Amor te he enviado el archivo como me lo solicitas.
Espero este entendible, agradezco mucho tu apoyo.
Saludos
Nahun Lopez
Te anexo la macro
Sub testNahun()
'---
' Por.Dante Amor
'---
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("En_Abierto")
Set h2 = Sheets("Planeamento COSTURA")
'
For i = h2.Range("B" & Rows.Count).End(xlUp).Row To 4 Step -1
If h2.Cells(i, "B") <> "" Then
Set r = h1.Columns("B")
Set b = r.Find(h2.Cells(i, "B"), lookat:=xlWhole)
una = True
n = 1
If Not b Is Nothing Then
celda = b.Address
Do
fila = i
If Not una Then
h2.Rows(i + n).Insert , CopyOrigin:=xlFormatFromLeftOrAbove
fila = i + n
n = n + 1
End If
h2.Cells(fila, "D") = h1.Cells(b.Row, "G")
h2.Cells(fila, "E") = h1.Cells(b.Row, "H")
una = False
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
