Macro para seleccionar, copiar y pegar columnas discontinuas
Partiendo de esto:
Sub SELECCIONAR2()
Sheets("hoja1).Select
Set a = Range("b17", Range("b17").End(xlDown))
Set b = Range("C17", Range("C17").End(xlDown))
Set c = Range("d17", Range("d17").End(xlDown))
Set d = Range("f17", Range("f17").End(xlDown))
Set e = Range("g17", Range("g17").End(xlDown))
Union(a, b ,c ,d, e). Select
Quiero copiar esta selección discontinua y pegarla en la hoja 2, celda m1
3 Respuestas
Prueba con esta macro
Sub copiar_datos()
Set ho = Worksheets("hoja1")
Set hd = Worksheets("hoja2")
Set rango = Union(ho.Range("b17").CurrentRegion, ho.Range("f17").CurrentRegion)
With rango
.Copy: hd.Range("m1").PasteSpecial
End With
End Sub
¡Gracias!
Saludos James, gracias por la ayuda. James, solamente necesito que los rangos a copiar sean "B17 : D17" y "F17 , G17", como quedaría el código.
Gracias.
El código queda así
Sub copiar_datos()
Set ho = Worksheets("hoja1")
Set hd = Worksheets("hoja2")
Set rango = Union(ho.Range("b17:d17"), ho.Range("f17:g17"))
With rango
.Copy: hd.Range("m1").PasteSpecial
End With
End Sub
Si tienes algo como esto:
Y lo quieres así:
entonces , quedaría la macro de esta forma:
Sub SELECCIONAR2()
Sheets("hoja1").Select
Set a = Range("b17", Range("b17").End(xlDown))
Set b = Range("C17", Range("C17").End(xlDown))
Set c = Range("d17", Range("d17").End(xlDown))
Set d = Range("f17", Range("f17").End(xlDown))
Set e = Range("g17", Range("g17").End(xlDown))
Union(a, b, c, d, e).Copy Sheets("Hoja2").Range("M1")
End SubAvísame cualquier duda
.
.
Ahí te adjunto el código del desarrollo de tu consulta.
Sub CopiarRangos()
Sheets("Hoja1").Select
Dim a As Range, b As Range, c As Range, d As Range, e As Range
Set a = Range("a1", Range("a1").End(xlDown))
Set b = Range("C1", Range("C1").End(xlDown))
Set c = Range("d1", Range("d1").End(xlDown))
Set d = Range("f1", Range("f1").End(xlDown))
Set e = Range("g1", Range("g1").End(xlDown))
Set RangoUnido = Union(a, b, c, d, e)
RangoUnido.Copy
Sheets("Hoja2").Select
Range("M1").PasteSpecial
End SubAnder GS.
¡Gracias!
Hola Ander gracias por la ayuda , pero cuando ejecuto la Macro aparece error en la línea de Rangounido.Copy ¿qué pudo haber pasado?
Sheets("datasheet").Select
Set a = Range("b17", Range("b17").End(xlDown))
Set b = Range("C17", Range("C17").End(xlDown))
Set c = Range("d17", Range("d17").End(xlDown))
Set d = Range("f17", Range("f17").End(xlDown))
Set e = Range("g17", Range("g17").End(xlDown))
Set RangoUnido = Union(a, b, c, d, e)
RangoUnido.Copy
Sheets("hoja2").Select
Range("a4").PasteSpecial
End Sub
He ejecutado el código que proporcionaste y ejecuta bien. ¿Qué error te muestra cuando ejecutas la macro?
Te aseguraste que todos los rangos a, b, c, d y e tienen igual tamaño. Si no lo tienen entonces te muestra un error en la línea RangoUnido. Copy
Cualquier consulta estaré atento.
Ander GS
Uhmmm, los tamaños no son iguales, como haría, ya que la hoja "datasheet" es una formato predeterminado.
hola Ander, tienes razón, las columnas no tienen el mismo tamaño, como quedaría el codigo, partiendo de esa situación.
gracias!!
Adjunto código para su revisión, considerando rangos de diferentes tamaños.
Sub CopiarRangos()
Dim Celda As String, Rango As Range, Col(0 To 4) As String
Col(0) = "B"
Col(1) = "C"
Col(2) = "D"
Col(3) = "F"
Col(4) = "G"
For i = 0 To 4
Sheets("datasheet").Select
Celda = Col(i) & "17"
Set Rango = Range(Celda, Range(Celda).End(xlDown))
Rango.Copy
Sheets("hoja2").Select
Range("a4").Offset(0, i).PasteSpecial
Next i
End SubPor favor no olvidar de valorar las respuestas.
¡Gracias!
Excelente !!! Ander!!! me haces Feliz!!! gracias.
Que bueno que te haya servido de mucho y puedas seguir avanzando con tu proyecto.
Por favor, no olvidar de valorar las respuestas.