Macro para copiar celdas de selecciones múltiples en otro rango en Excel

Es sabido que en Excel no podemos hacer el copiado de celdas si éstas se encuentran en selecciones múltiples y en diferentes columnas. No tenemos problema cuando elegimos celdas no adyacentes de la misma columna y las pegamos en otro rango.

image

Figura 1. Copiar selección múltiple en Excel.

Pero cuando deseamos copiar celdas que están en diferentes columnas veremos un mensaje que dice de manera textual “No se puede ejecutar este comando en selecciones múltiples”. Este mensaje nos impide hacer el copiado de las celdas, por lo que debemos de hacer uso de una macro.

image

Figura 2. Excel no permite copiar celdas no adyacentes.

Elegir celdas no adyacentes con Buscar y seleccionar

Ahora bien, en el ejemplo vemos una lista de empresas las cuales tienen a su vez hasta 5 emails de contacto, los cuales deseamos pasar a otro rango a manera de lista. El comando Buscar y seleccionar de Excel nos permitirá buscar todas aquellas celdas con tengan una arroba ‘@’, para posteriormente elegirlas.

Cómo lo hacemos

Presionamos [Ctr] + [B] e ingresamos ‘@’ en el campo Buscar y damos click en Buscar todos. Se mostrará una lista con todas las celdas que contegan el caracter ingresado. Bastará con seleccionar toda la lista mostrada y veremos cómo se eligen las celdas de nuestra hoja.

image

Figura 3. Usando Buscar y seleccionar para elegir todos los emails de la tabla de ejemplo.

Macro para copiar emails a otro rango

La macro que usaremos en este ejemplo hace uso del Método InputBox para poder elegir el rango en el cual los emails serán pegados.

Cuando hayamos realizado el procedimiento anterior de elegir los emails, ejecutamos la macro. La macro primeramente pedirá el rango de destino donde los valores serán pegados. Puede ser en la misma hoja u otra hoja del archivo. Recomiendo elegir una celda de destino para no perder datos.

image

Figura 4. Copiando valores de celdas múltiples con macros.

Código vba

Ubicación: Módulo 1

'---------------------------------------------------------------------------------------
' Module    : Módulo1
' Author    : MVP, Sergio Alejandro Campos
' Date      : 18/05/2015
' Purpose   : Copiar celdas adyacentes
'---------------------------------------------------------------------------------------
'
Sub CopiarCeldas()
'
'Declaramos variables
Dim RangoDestino As Range
Dim Cuenta As Integer
Dim Celda As Range
    '
    'En caso de error
    On Error GoTo ManejoError
    '
    'Definimos la variable de la celda de destino
    Set RangoDestino = Application.InputBox("Elije la celda destino:", _
                                            "EXCELeINFO - Copiar celdas", _
                                            Type:=8)
    '
    Cuenta = 0
    '
    'Recorremos la selección y la pegamos en el detino
    For Each Celda In Selection
        '
        RangoDestino.Offset(Cuenta, 0).Value = Celda.Value
        Cuenta = Cuenta + 1
        '
    Next Celda
    '
    Exit Sub
ManejoError:
    '
End Sub

También te podría gustar...