Flytte tekst fra flere celler til en

Lad os se den nævnte kode!

Ups, ja, det kan du have ret i. Her er den:

Sub FlytteData()
   
    Dim Temp As String, RW As Long, CO As Long, Antal As Long
    RW = Selection.Row
    CO = Selection.Column
    Antal = Selection.Rows.Count - 1
    For Each c In Selection
        If Not IsEmpty(c) Then
            Temp = Temp & c & "," & " "
        End If
    Next
    Temp = Left(Temp, Len(Temp) - 1)
    Cells(RW, CO) = Temp
    Cells(RW, CO).WrapText = True
    Range(Cells(RW + 1, CO), Cells(RW + Antal, CO)) = ""
End Sub

Er der nogen, som har et bud. Ovennævnte kode sætter alle data i første markerede celle med kommm + mellemrum og flere linjer. Jeg vil gerne have, at jeg selv kan vælge, hvilken celle, dataene skal stå i.

Denne her virker - flytter data til A1

Sub DataTilEnCelle()

Dim outputText As String
Const tegn = ", "

On Error Resume Next

For Each Cell In Selection
If Not IsEmpty(Cell) Then
outputText = outputText & Cell.Value & tegn
End If

Next Cell

Range("A1").Select


With Selection
.Clear
.Value = outputText
.Value = Left(.Value, Len(.Value) - 2)
.WrapText = True
End With

End Sub