Remove linespaces but not the lines in range of cells with text.

Your column A (Before) and Column E (after) are the exact same.

Hi Davesexcel.
I just checked its not the same in column E there is linespaces in the text .
Like this.
-------
Remove the line spaces but not the lines also above
space
Example this
--------
But i want this the space go away but not the line. In column E it look like this copied directly in here.

Like this.
-------
Remove the line spaces but not the lines also above
Example this
No space
--------
You can see it in the upper bar. And here you can also remove the line space manually. But i have really many cells in this column thats why would like to have a macro.
Sincerely Abjac

Please try in B6 and copy down:

Formula:

=SUBSTITUTE(A6,CHAR(10)&CHAR(13),"")

I can do it like this. Its a lets say extremely not nice solution but its working. If some can do this better would be nice.
I paste formula into K6 and down the one provided here. With a macro.
I use other formula to only show values. After i move all to column A6 and down and in the end i unwrap it also with macro.
It look like below but very not nice but seems to be working.
If some and i am sure can do this more easy would be great.
Sincerely Abjac

Sub formulas()
Sheet1.Select
    Range("K6").Select
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-10],CHAR(10)&CHAR(13),"""")"
    Range("K6").Select
    Selection.AutoFill Destination:=Range("K6:K12"), Type:=xlFillDefault
    Range("K6:K2000").Select
    Range("A1").Select
Call ChangingFormulasToValue
End Sub

Sub Move()
Sheet1.Select
    Range("K6:K2000").Select
    Selection.Cut
    Range("A6").Select
    ActiveSheet.Paste
    Range("A1").Select
    Call wrap
End Sub

Sub wrap()
    Sheet1.Select
    Range("A6:A2000").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveSheet.Rows("6:2000").RowHeight = 15
    Range("A1").Select
End Sub

Option Explicit

Sub ChangingFormulasToValue()
Sheet1.Select
'Declaring variables
Dim SourceRng As Range

'Specify all cells in the active sheet as range
Set SourceRng = Range("K6", Range("K6").SpecialCells(xlCellTypeLastCell))

'Assigning only value of the cell skipping formula of the cell
SourceRng.Value = SourceRng.Value
Call Move
End Sub