Macro que desplace el contenido de las celdas al encontrar una vacia
Nesecito una macro que me desplace el valor contenido en celda para no dejar celdas vacias, me explico, se trata del control de paquteria donde por ejemplo en a1, a2, a3 etc se van capturando consecutivamente datos alfa numericos correspondientes a numeros de pedidos de paqueteria en espera, pero cuando se recibe algun paquete correspondiente a un numero que se encuentra entre dos celdas ocupadas (por elemplo el valor de A2) al eliminar el numero de pedido recibido, se nesecita que los demas valores de las celdas a la derecha se desplacen ocupando el espacio que dejo la celda del paquete recibido osea que A3, ocupe el lugar de A2 pero solo los valores ya que las celdas tiene formato y asi tambien sucede con cada fila a, b, c, d, etc
Saludos cordiales a toda la comunidad de expertos.
1 Respuesta
.02/11/16
Buenas, Alfredo
Te comparto una rutina que hace, creo, lo que interpreté que pedías.
En principio la rutina está asociada a un atajo de teclado [Ctrl + W] que deberás presionar en cualquier celda de la fila que quieres acomododar.
Accede al Editor de VBA (Atajo: Alt + F11), allí inserta un módulo (Insertar-Módulo) y pega el siguiente código:
Sub acomoda() 'atajo de teclado : Ctrl + w '---- Variables modificables ---- '=== ALFREDO, modifica estos datos de acuerdo a tu proyecto: IniColPaq = "I5" 'Columna inicio detalle de paquetes Buscar = "Accomodation,Regular" 'texto a buscar HojaDest = "Accomodation,Regular" ' Hoja donde dejar las líneas TitDestino = "A13:BH13" ' fila de títulos en hoja de destino '---- fin Variables ' '---- inicio de rutina: CelAct = Cells(ActiveCell.Row, Range(IniColPaq & "5").Column).Address CantCols = Range(IniColPaq).CurrentRegion.Columns.Count For LaColumna = 0 To CantCols - 1 If IsEmpty(Range(CelAct).Offset(0, LaColumna)) Then For LaCeldaN = LaColumna + 1 To CantCols - 1 If Not IsEmpty(Range(CelAct).Offset(0, LaCeldaN)) Then Range(CelAct).Offset(0, LaColumna).Value = Range(CelAct).Offset(0, LaCeldaN).Value Range(CelAct).Offset(0, LaCeldaN).ClearContents Exit For End If Next End If Next End Sub
.
Sí, me imaginé que querrías que lo haga en toda la hoja, pero quería asegurarme primero de que fuese lo que estabas buscando.
Así que esta versión hace el acomodamiento en toda la hoja repitiendo aquella rutina para cada fila:
Sub acomoda() 'atajo de teclado : Ctrl + w '---- Variables modificables ---- '=== ALFREDO, modifica estos datos de acuerdo a tu proyecto: IniColPaq = "I5" 'Columna inicio detalle de paquetes ColCant = "D" 'columna donde están los numeros de parte '---- fin Variables ' '---- inicio de rutina: ' UltFila = Range(ColCant & Rows.Count).End(xlUp).Row CantCols = Range(IniColPaq).CurrentRegion.Columns.Count For LaFila = 1 To UltFila For LaColumna = 0 To CantCols - 1 CelAct = Range(IniColPaq).Offset(LaFila, LaColumna).Address If IsEmpty(Range(CelAct)) Then For LaCeldaN = LaColumna + 1 To CantCols - 1 If Not IsEmpty(Range(IniColPaq).Offset(LaFila, LaCeldaN)) Then Range(CelAct).Value = Range(IniColPaq).Offset(LaFila, LaCeldaN).Value Range(IniColPaq).Offset(LaFila, LaCeldaN).ClearContents Exit For End If Next End If Next Next End Sub
Espero que ahora sí esté OK.
Abrazo
Fer
.
Fernando eres un profesional, agradesco tus conocimientos que son bastos, pero mas tu dispisicion y buen trato, como siempre es un placer y honor aprender de ti ¡Gracias!
