Para DANTE AMOR como aplicar texto en columnas

Hola Dante

Tengo la siguiente macro

Sub GrabarPacienteNuevo()
    Range("D10") = UCase(Range("D10"))
    Range("D13") = UCase(Range("D13"))
    Range("D18") = UCase(Range("D18"))
    Range("D16") = LCase(Range("D16"))
    Application.ScreenUpdating = False
    Set h1 = Sheets("INGRESAR_CITA")
    Set h2 = Sheets("BASE")
    Dim f As Date
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
    h1.Range("D200:D204").Copy
    h2.Range("A" & u2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    h1.Range("D205:D212").Copy
    h2.Range("G" & u2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Application.CutCopyMode = False
    h1.Range("D500").Copy
    h2.Range("T" & u2).PasteSpecial Paste:=xlPasteValues, Transpose:=False
    Application.CutCopyMode = False

Después de copiar el dato de la celda "D500" como valor en a columna "T" quisiera transformar ese dato a texto en columnas a partir de la columna siguiente es decir la columna "U"

Tener en cuenta que el dato que esta contenido en la columna "T" esta delimitado por el carácter "@" es decir tiene la siguiente estructura como ejemplo "Carro@Bicicleta@@Motocicleta"

Es decir, la quiero separar en 4 columnas, para el caso anterior se llenarian las columnas 1=Carro, 2=Bicicleta, la columna 3 quedaria vacia y la 4=Motocicleta

Recuerda que el separador de las palabras es "@"

Espero me puedas ayudar con esa instrucción y Gracias

1 Respuesta

Respuesta
1

Te regreso la macro

Sub GrabarPacienteNuevo()
    Range("D10") = UCase(Range("D10"))
    Range("D13") = UCase(Range("D13"))
    Range("D18") = UCase(Range("D18"))
    Range("D16") = LCase(Range("D16"))
    Application.ScreenUpdating = False
    Set h1 = Sheets("INGRESAR_CITA")
    Set h2 = Sheets("BASE")
    Dim f As Date
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
    h1.Range("D200:D204").Copy
    h2.Range("A" & u2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    h1.Range("D205:D212").Copy
    h2.Range("G" & u2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    h1.Range("D500").Copy
    h2.Range("T" & u2).PasteSpecial Paste:=xlPasteValues, Transpose:=False
    datos = Split(h2.Range("T" & u2), "@")
    col = Columns("U").Column
    For i = LBound(datos) To UBound(datos)
        h2.Cells(u2, col) = datos(i)
        col = col + 1
    Next
    Application.CutCopyMode = False
End Sub

Saludos.Dante Amor

No olvides valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas