Macro para copiar celdas en otra hoja siempre y cuando las celdas no estén vacías
Ante todo me ha servido muchísimo esta página para ir aprendiendo acerca de VBA y agradecerles desde ya a los expertos que se toman su tiempo en contestarnos.
Ahora bien, les consulto porque anteriormente vi una pregunta de como copiar celdas a otra hoja
De la cual pude sacar lo siguiente:
libre = Sheets("Registros").Range("H1048576").End(xlUp).Row + 1
ActiveSheet.Range("F5:I5").Copy Destination:=Sheets("Registros").Cells(libre, 8)
Mi idea es copiar todo lo que esta en el rango de F5:I19, el tema es que quiero que la macro me copie línea por línea es decir F5:I5 luego F6:I6 y así sucesivamente hasta F19:I19 siempre y cuando cada una de las filas tengan datos.
Pensé en hacer un while y que me recorra y copie fila por fila hasta que encuentre una fila vacía y salga.
Pero no termino de armar bien la macro, y es por esto que acudo a ustedes.
Espero me puedan ayudar, estoy usando excel 2013
1 Respuesta
Esta sería una forma, con la instrucción Application. CountA, contamos cuantos datos existen en el rango, si hay más de 0, significa que si hay datos entonces copia la fila.
Sub copiar()
'Por.Dante Amor
Set h1 = ActiveSheet
Set h2 = Sheets("Registros")
For i = 5 To 19
cuenta = Application.CountA(h1.Range(h1.Cells(i, "F"), h1.Cells(i, "I")))
If cuenta > 0 Then
u = h2.Range("H" & Rows.Count).End(xlUp).Row + 1
h1.Range(h1.Cells(i, "F"), h1.Cells(i, "I")).Copy h2.Cells(u, "H")
End If
Next
End SubNo olvides valorar la respuesta.
Buenas tardes Dante, de antemano gracias por tu pronta respuesta.
Me funciona correctamente, una consulta mas por si me puedes ayudar.
Hay manera de que se pueda copiar solo los valores? ya que las celdas que quiero copiar hay una columna que la tengo como una lista desplegable.
de igual manera gracias por la ayuda.
Saludos y Felices Fiestas!
Te anexo la macro con la actualización
Sub copiar()
'Por.Dante Amor
Set h1 = ActiveSheet
Set h2 = Sheets("Registros")
For i = 5 To 19
cuenta = Application.CountA(h1.Range(h1.Cells(i, "F"), h1.Cells(i, "I")))
If cuenta > 0 Then
u = h2.Range("H" & Rows.Count).End(xlUp).Row + 1
h1.Range(h1.Cells(i, "F"), h1.Cells(i, "I")).Copy
h2.Cells(u, "H").PasteSpecial Paste:=xlPasteValues
End If
Next
End SubAl final de mi respuesta dice: “Es una buena respuesta” y puedes seleccionar una de 3 opciones:
- Excelente
- Si
- No
