Copiar Datos de Columna con datos y vacíos
Necesito por favor me ayuden para saber como puedo hacer para copiar los datos de una columna los cuales tiene y no tienen dato, es similar a la función ShifT + Fin con el teclado, pero como ya sabrán esta función al encontrar una celda en blanco no continua y se queda allí. Como lo puedo hacer con VBA.
2 Respuestas
[Hola
Te paso la macro
Esto copia datos de la columna A a la columnas D
Para finalizar hay 2 opciones Excelente o bueno saludos!
Sub copiar_datos()
'Por Adriel Ortiz
'
Set h1 = ActiveSheet
'
u = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("A2:A" & u).Copy h1.Range("D2")
'
MsgBox "Datos copiados"
End Sub
¡Gracias!
Si tienes dudas coméntame con una imagen los datos a copiar y el destino a pegar
Esta podría ser una de las tantas formas que puedes usar
con while activecell.value<> " "
Wend
O
Do while activecell.value<>" "
if activecell.offset.value <> " " then
Range(activecell.offset(0,-3), activecell.offset(0,54)).copy
activecell.offset(1,0).select
sheets("destino").select
activecell.pastespecial
sheets("origen").select
Aquí puse unos datos ficticios porque no sé el nombre de la hoja de origen y nombre de la hoja destino, no se si se trata del mismo libro o son diferentes libros, pero si gustas mándame tu archivo a [email protected] para trabajarlo.
¡Gracias! Pero me explico mejor la instrucción es busco con la función buscar ctrl + b un dato luego me paro una fila mas abajo y de allí le doy Shift+Fin pero lógicamente que al hacer eso y si hay filas en blanco entonces se detiene y no selecciona todo. Intente usar lo que me envió pero no pude ya que me informa que falta un loop y al colocárselo me genera error.
Un favor mándame tu archivo al correo y en tu archivo me pones los datos esperados.
Hola ya te e enviado el archivo a tu email
Sub copiadox()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim orin As Worksheet: Set orin = wb.Sheets("Arch_Cliente")
Dim desti As Worksheet: Set desti = wb.Sheets("Maes_Origen")
Dim finte
Dim y
Dim u2
orin.Select
Range("b2").Select
finte = orin.Range("b" & Rows.Count).End(xlUp).Row
u2 = desti.Range("D" & Rows.Count).End(xlUp).Row
If u2 < 2 Then u2 = 4
For y = 2 To finte
If orin.Cells(y, 2) <> "" Then
orin.Cells(y, 3).Copy desti.Cells(u2, 4)
u2 = u2 + 1
End If
Next
End Sub