Eliminar saltos de linea dentro de una misma celda de excel

Para Dante o cualquiera que me pueda ayudar.

Hola, saludos.

El caso es que necesito relizar una tarea que consiste en dos pasos. Convertir una tabla de excel con formato irregular( filas con distinto numero de celdas en altura) en formato regular(todas las filas ocupan sólo una celda de altura) para posteriormente concatenar el contenido de cada fila en una sola celda.

El caso es que tengo una macro para cada parte del proceso pero no consigo terminar con el formato deseado ya que al correr la primera macro me quedan lineas vacías sin contenido dentro de las celdas por lo que al concatenar me queda un formato que no es que busco.

La cuestion es que no se si deberia actuar sobre la primera macro, sobre la segunda o sobre ambas.

He aqui la macro primera

Sub macro1doors()
    Dim W1 As Worksheet
    Dim W2 As Worksheet
    Dim i As Integer
    Dim j As Long
    Dim h As Integer
    Dim k As Integer
    Dim l As Long
    Dim StrCellContent As String
    Dim Cont As Long
    Dim Cabeceras(0 To 10) As String
    Set W1 = Application.ActiveWorkbook.Worksheets("Hoja1")
    Set W2 = Application.ActiveWorkbook.Worksheets("Hoja2")
'comienza desde la celda activa(se podria modificar el inicio)
i = ActiveCell.Row
j = ActiveCell.Column
l = 0
Cont = W1.Range("A" & Rows.Count).End(xlUp).Row
'Bucle que barre filas
While Cells(i, j) <> ""
l = l + 1
   h = 0
        Do
        h = h + 1
        Loop While Cells(i + h, j) = "" And h < Cont
'Bucle que barre columnas
    While Cells(i, j) <> ""
    StrCellContent = ""
    k = 0
        For k = 0 To h - 1
        StrCellContent = StrCellContent & Cells(i + k, j) & Chr(10)
        Next k
        W2.Cells(l, j) = Left(StrCellContent, Len(StrCellContent))
    j = j + 1
    Wend
i = i + h
j = 1
Wend
 W2.Select
    W2.Columns("A").WrapText = False
MsgBox "Terminado"
End Sub

y aqui la segunda

Sub Concatenar()
    Dim j As Long
    Dim W1 As Worksheet, W2 As Worksheet
    Dim wbkTarget As Workbook
    Set W1 = Selection.Parent
    Set wbkTarget = W1.Parent
    For idx = 1 To wbkTarget.Worksheets.Count
        If wbkTarget.Worksheets(idx).Name = W1.Name Then Exit For
    Next idx
    If idx < wbkTarget.Worksheets.Count Then Set W2 = wbkTarget.Worksheets(idx + 1)
    kk = W1.Name
    gg = W2.Name
    W2.Cells.ClearContents
    k = 1
    For i = 1 To W1.Range("A" & Rows.Count).End(xlUp).Row
        con = ""
        If W1.Cells(i, 1) <> "" Then
            If W1.Cells(i, 1) = "STEP" Then
                f = i
            Else
                For j = 2 To W1.Cells(f, Columns.Count).End(xlToLeft).Column
                    con = con & W1.Cells(f, j) & ": " & Chr(10) & W1.Cells(i, j) & Chr(10)
                Next
                W2.Cells(k, 1) = Left(con, Len(con))
                k = k + 1
            End If
        End If
    Next
    W2.Select
    W2.Columns("A").WrapText = False
    MsgBox "Terminado"
End Sub

si alguien cree que me podria ayudar le puedo enviar el libro de excel con el ejemplo y las macros incluidas ya que no me caben las iamgenes ilustrativas en la pregunta.

Respuesta
2

Te anexo la macro

Sub acomodar()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja5")
    h2.Cells.Clear
    k = 1
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        If h1.Cells(i, "A") <> "" Then
            For j = 2 To 5
                h2.Cells(k, "A") = h2.Cells(k, "A") & h1.Cells(1, j) & ":" & Chr(10)
                For Each r In h1.Cells(i, "A").MergeArea.Rows
                    If h1.Cells(r.Row, j) <> "" Then
                        h2.Cells(k, "A") = h2.Cells(k, "A") & "     " & h1.Cells(r.Row, j) & Chr(10)
                    End If
                Next
            Next
            h2.Cells(k, "A") = h2.Cells(k, "A") & Chr(10)
            k = k + 1
        End If
    Next
    h2.Columns(1).ColumnWidth = 96
    h2.Select
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas