Seleccionar, copiar y pegar en primera columna vacia
Buenas noches, estoy intentando hacer una macro que recorra una columna que tiene intercaladas celdas en blanco de forma variable, entre 2 y 1 celdas en blanco, y continua con una o dos o tres filas rellenas y otra vez 1 ó 2 celdas en blanco. Bien pues quisiera que recorriera la columna seleccionada y una vez llegue a una celda en blanco copie las 5 celdas de la derecha y las pegue en la fila anterior rellena completamente, y continué corriendo si la siguiente fila es también blanco que la sitúe a continuación de la anterior, ejemplo:
A B C D E F G H I J K L
1 21 22 23 30 32 40 25 28 50 38 44 60
2 25 28 50
3 38 44 60
4 54 65 78 79 32 55 45 35 10
5 45 35 10
6 25 99 75 44 45 11
Seria posible, me ayudara con esta macro??
Saludos cordiales
1 respuesta
Te dejo el código que, espero, te ayuda con tu necesidad. Quedo pendiente de tu éxito. Saludos
Sub AunaSolaFila() ''Creada por FSerrano en 120221 ''para cmgata en TodoExpertos.com ''Arma grupos en una sola fila, eliminando las celdas en blanco inicio = ActiveCell.Address Cells(ActiveSheet.Rows.Count, ActiveCell.Column).Select ultimafila = Selection.End(xlUp).Row Range(inicio).Select actual = Range(inicio).Row For i = ActiveCell.Row To ultimafila If IsEmpty(Cells(i, Range(inicio).Column)) Then Rows(i).SpecialCells(xlCellTypeConstants).Copy ActiveSheet.Cells(actual,Application.WorksheetFunction.CountA(Rows(actual)) + 1).PasteSpecial paste:=xlValues Application.CutCopyMode = False Else actual = i End If Next End Sub
NO OLVIDES FINALIZAR Y PUNTUAR LA PREGUNTA
Muchas gracias Nefese, por su pronta respuesta funciona perfectamente, pero se me paso una cosita, puede ampliar el código para que una vez se haya pegado en una fila elimine las filas que contienen blancos.
Si necesita que finalice esta pregunta y abrir una nevá, por favor ruego me lo diga.
para que las filas se eliminen debes incluir esta línea al final del código (entre el NEXT y el END SUB)
Columns(Range(inicio). Column). SpecialCells(xlCellTypeBlanks). EntireRow.Delete
luego de esto, debería funcionar como quieres.
