Macro copiar cada seis celdas hasta encontrar celda en blanco
Necesito que me ayuden con algo
Tengo un rango de datos en la columna D, necesito copiar 6 celdas hacia abajo desde D5 y pegarlas en otra hoja de excel en la celda A1 luego copiar las siguientes 6 celdas y pegarlas en la otra hoja en B1 y así hasta que encuentre una celda vacía.
2 Respuestas
Esto puede aportar algo más
Para ir cada 6 celdas puedes usar step en un ciclo for así
For x= 1 to 100 step 6
Next x
Esto significa que 6 ira comando el valor 6, 12, 18 etc.
En los dos últimos hay un ejemplo de como se usa la estructura for... next
Te anexo la macro
Sub Copiar_Celdas()
'Por Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1") 'hoja origen
Set h2 = Sheets("Hoja2") 'hoja destino
'
h2.Cells.ClearContents
j = 1
For i = 5 To h1.Range("D" & Rows.Count).End(xlUp).Row Step 6
h1.Range("D" & i & ":D" & i + 5).Copy
h2.Cells(1, j).PasteSpecial xlValue
j = j + 1
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
Muchas gracias por tu pronta respuesta
Podrías por favor explicarme un poco como funciona esta macro
De nuevo muchas gracias
Buenos días
Dante,
Tu macro funciona casi perfecto, el tema es que creo que no me expliqué bien; Tengo los valores en la columna D, pero organizados así: 100 valores, un espacio en blanco, otros 100 valores y otro espacio y así hasta el final de la data, con tu macro funciona perfecto las primeras 100 luego cuando llega al final de las primeras 100 copia el espacio y las siguientes 5, pero lo que necesito es que cuando encuentre el primer espacio en blanco copie las siguientes 6, no se si me explico mejor.
Agradecería tu colaboración
Te anexo la macro actualizada
Sub Copiar_Celdas()
'Por Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1") 'hoja origen
Set h2 = Sheets("Hoja2") 'hoja destino
'
h2.Cells.ClearContents
j = 1
For i = 5 To h1.Range("D" & Rows.Count).End(xlUp).Row
ini = i
fin = i + 5
For k = i To i + 5
If h1.Cells(k, "D").Value = "" Then
fin = k
Exit For
End If
Next
h1.Range("D" & ini & ":D" & fin).Copy
h2.Cells(1, j).PasteSpecial xlValue
i = fin
j = j + 1
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub