Macro VBA. Quiero que copie un rango desde una celda hasta la última con datos pero da error.
Estoy haciendo una Macro y quiero que me copie los datos de una pestaña (BUQUENUEVO) a otra pestaña dentro del mismo libro (VALDEMORO). El problema es que quiero que seleccione en la columna I todas las celdas con datos desde la I2 y luego copie todas las celdas hasta columna A.
Los datos de BUQUENUEVO vienen desde otro Excel. La macro lee pestaña a pestaña del otro excel y hace un loop hasta que no hay más pestañas.
Dónde viene el problema. Cuando en BUQUENUEVO hay más celdas después de la I2 con datos, me selecciona correctamente todas las celdas con datos y copia el rango correcto. Cuando en BUQUENUEVO sólo la celda I2 tiene datos, coge celdas vacías cuando le doy la orden de llegar hasta la última con datos :(
Aquí es donde voy un poco perdida y no se como hacerlo realmente :( Este es el código que me da el error, marcado en negrita.
'Copia y pega las columnas hasta compañia en la pestaña de Valdemoro
ActiveWorkbook. RefreshAll
Sheets("BUQUENUEVO").Select
Rows("1:1").Select
Selection.AutoFilter
Range("K2", Range("K2").End(xlDown).End(xlToLeft).End(xlToLeft).End(xlToLeft).End(xlToLeft).End(xlToLeft)).Select
Selection.Copy
Sheets("VALDEMORO").Select
Columns("K:K").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
ActiveCell. Offset(0, -10). Activate
ActiveSheet. Paste
Había probado también con este código y me da error igual:
'Copia y pega las columnas hasta compañia en la pestaña de Valdemoro
ActiveWorkbook. RefreshAll
Sheets("BUQUENUEVO").Select
Rows("1:1").Select
Selection.AutoFilter
Range("K2").Select
Range(Selection, Selection(xlCellTypeLastCell).Offset(1, 0)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
Sheets("VALDEMORO").Select
Columns("K).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
ActiveCell.Offset(0, -10).Activate
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Tiene bases de datos grandes prueba combinar la búsqueda con SQL así
2 respuestas más de otros expertos
Te anexo la macro, pero con otra forma de copiar y pegar.
Entendí lo siguiente, quieres copiar de la hoja "BUQUENUEVO" las celdas desde A2 hasta la columna K y última fila con datos, y pegarlos en la hoja "VALDEMORO", en la siguiente fila vacía según la columna K.
Prueba con la siguiente macro para copiar los datos de "BUQUENUEVO" a "VALDEMORO" y me dices si es lo que necesitas.
Sub Pegar_Datos()
'Por Dante Amor
Set h1 = Sheets("BUQUENUEVO") 'hoja origen
Set h2 = Sheets("VALDEMORO") 'hoja destino
h1.Range("A2:K" & h1.Range("K" & Rows.Count).End(xlUp).Row).Copy h2.Range("A" & h2.Range("K" & Rows.Count).End(xlUp).Row + 1)
MsgBox "Datos copiados"
End SubDespués de la prueba, me explicas cómo quieres el ciclo para copiar los datos de otras hojas.
'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
¡Gracias! Finalmente conseguí que la macro funcionara. El problema era que si no había datos en K3, solo en K2, al seleccionar desde K2 hasta la última con datos me cogía líneas en blanco hasta casi la línea 4000.
He usado un IF THEN, ELSE.
Si la casilla K3 está en blanco, que copie de la celda A2 hasta la K2 y la pegue en Valdemoro desde la K que esté vacía.
Si la casilla K3 tiene datos, busca desde la K2 hasta la última con datos y copia el Rango de A2 hasta la KX con datos, y esto lo pega en Valdemoro desde la primera K que esté vacía.
''' condicion ELSE IF K2 blank ---
If Sheets("BUQUENUEVO").Range("K3") = "" Then
Range("K2", Range("K2").End(xlToLeft).End(xlToLeft).End(xlToLeft).End(xlToLeft).End(xlToLeft)).Select
Selection.Copy
Sheets("VALDEMORO").Select
Columns("K:K").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
ActiveCell.Offset(0, -10).Activate
ActiveSheet.Paste
Else
Range("K2", Range("K2").End(xlDown).End(xlToLeft).End(xlToLeft).End(xlToLeft).End(xlToLeft).End(xlToLeft)).Select
Selection.Copy
Sheets("VALDEMORO").Select
Columns("K:K").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
ActiveCell.Offset(0, -10).Activate
ActiveSheet.Paste
End IfUn saludo!!
Un código más simple es el siguiente, la primera instrucción copiara solo la cantidad de filas que tenga la columna I llenas puede ser una o un millón y las pasara al range("a2") de la hoja valdemoro
Sub copiar()
Sheets("buquenuevo"). Range("i2"). CurrentRegion. Copy
Sheets("valdemoro"). Range("a2"). PasteSpecial
End Sub
¡Gracias! Finalmente conseguí que la macro funcionara. El problema era que si no había datos en K3, solo en K2, al seleccionar desde K2 hasta la última con datos me cogía líneas en blanco hasta casi la línea 4000.
He usado un IF THEN, ELSE.
Si la casilla K3 está en blanco, que copie de la celda A2 hasta la K2 y la pegue en Valdemoro desde la K que esté vacía.
Si la casilla K3 tiene datos, busca desde la K2 hasta la última con datos y copia el Rango de A2 hasta la KX con datos, y esto lo pega en Valdemoro desde la primera K que esté vacía.
''' condicion ELSE IF K2 blank ---
If Sheets("BUQUENUEVO").Range("K3") = "" Then
Range("K2", Range("K2").End(xlToLeft).End(xlToLeft).End(xlToLeft).End(xlToLeft).End(xlToLeft)).Select
Selection.Copy
Sheets("VALDEMORO").Select
Columns("K:K").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
ActiveCell.Offset(0, -10).Activate
ActiveSheet.Paste
Else
Range("K2", Range("K2").End(xlDown).End(xlToLeft).End(xlToLeft).End(xlToLeft).End(xlToLeft).End(xlToLeft)).Select
Selection.Copy
Sheets("VALDEMORO").Select
Columns("K:K").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
ActiveCell.Offset(0, -10).Activate
ActiveSheet.Paste
End IfUn saludo!!