Macro copiar y pegar diferentes celdas en otra hoja por medio de un Ciclo
Es un gusto saludarlos.
Les cuento mi problema:
Necesito copiar datos a otra hoja (hoja1 ---> hoja2), desde las celdas:
- B2 a D2, luego de E1 hasta V1 y de E41 hasta V41
Copiar en hoja2 en las celdas:
- B2 a D2, luego de E1 hasta V1, y de E2 hasta V2.
Todo esto realizado por medio de un ciclo repetitivo cada 41 filas.
Son aprox. 60 ciclos.
Si no es mucho pedir... En la hoja1 entre las celdas A5:C40 existe
Una foto que sería ideal pegar en las mismas celdas pero en la hoja2 (esto forma parte del ciclo)
1 Respuesta
H o l a:
Copio estas:
B2 a D2, luego de E1 hasta V1 y de E41 hasta V41
Y las pego en estas:
B2 a D2, luego de E1 hasta V1, y de E2 hasta V2 (¿seguro qué en este último es E2 a V2?)
¿En el siguiente ciclo cuáles copio y en dónde las pego?
Si manualmente copias de B2 a D2 y pegas en B2 y se pega la imagen entonces la macro lo hará, pero si no se pega la imagen entonces tienes que poner la imagen dentro de los rangos que se van a copiar.
Mejor envíame tu archivo y me explicas con un ejemplo qué necesitas.
En el asunto recuerda poner tu nombre de usuario.
Gracias Dante, por favor dame tu correo.
Disculpa, no se pegó el correo, te lo anexo:
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “” y el título de esta pregunta.
Hola Dante,
Como verás, los datos a copiar desde hoja1 hacia hoja2 son los mismos (B2 a D2 y E1 a V1, posteriormente B43 a D43 y E43 a V43 para cumplir con el ciclo unas 60 veces)
La diferencia o variación está en copiar desde E41 a V41 en hoja1 y pegarlos en hoja2 en E2 a V2.
Para pegar la foto de cada ciclo, esta se encuentra en el rango de B5:C32, da igual donde quede pegada, la idea es que quede en ese rango.
Por favor cualquier duda me avisas.
Muchas gracias.
H o l a:
Te anexo la macro
Sub Copiar()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
Set b = h1.Columns("A").Find("Saldo", lookat:=xlPart, searchdirection:=xlPrevious)
If Not b Is Nothing Then
fila = b.Row
Else
fila = h1.Range("A" & Rows.Count).End(xlUp).Row
End If
h2.Select
h2.Pictures.Delete
h1.Select
'
For i = 2 To fila Step 41
h1.Range(h1.Cells(i, "B"), h1.Cells(i, "D")).Copy h2.Cells(i, "B")
h1.Range(h1.Cells(i - 1, "E"), h1.Cells(i - 1, "V")).Copy h2.Cells(i - 1, "E")
H1. Range(h1. Cells(i + 39, "E"), h1.Cells(i + 39, "V")). Copy
h2.Cells(i, "E"). PasteSpecial xlValues
For Each p In ActiveSheet.Pictures
If Not Intersect(p.TopLeftCell, h1.Range(h1.Cells(i, "A"), h1.Cells(i + 39, "C"))) Is Nothing Then
p.Select
alt = p.Top
izq = p.Left
Selection.Copy
h2.Paste
h2.Select
Selection.Top = alt
Selection.Left = izq
h1.Select
Exit For
End If
Next
Next
'
MsgBox "Terminado"
End Sub‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
