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.
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.
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.
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.
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