Del ved sidste hele ord

Er det bare en enkelt celle?

Så må du kunne bruge: Data -> Tekst til kolonner

Hvis du vil bruge en makro, så prøv at se på denne:

Sub DelTekstFoer60()
    Dim Mlr As Byte, Txt As String
    Txt = ActiveCell.Value
    Mlr = InStrRev(Txt, " ", 60)
    ActiveCell.Value = Left(Txt, Mlr - 1)
    ActiveCell.Offset(0, 1).Value = Mid(Txt, Mlr + 1, Len(Txt))
End Sub

Den deler en enkelt celle, men kan hurtigt skrives om til at dele alle celler i et markeret område.

Husk, at kolonnen ved siden af skal være tom.

Tak for hjælpen

Jeg har prøvet Jkrons løsning og den virker!!!

Hvordan vil macroen være hvis det er en hel kollone "B" jeg ønsker at få delt ud på kollone "C" & "D"

Håber i igen kan hjælpe!!

Skal det forblive i B når det deles ud på C og D, eller skal det samtidigt slettes fra B?

Denne kode fordeler teksten i markerede celler på de to kolonner til højre for. Så du markerer teksten i B-kolonnen og afspiller makroen.

Er teksten i en af de markerede kolonner for kort (altså kortere end 60, deles den ikke, men makroen stopper her med en fejl. Du må så markere resten igen og fortsætte. Den kan nok godt skrives om så tekster kortere end 60 overføres til kolonne C.

Sub DelTekstFoer60()
On Error GoTo fejl:
    Dim Mlr As Byte, Txt As String
    For Each c In Selection.Cells
        Txt = c.Value
        Mlr = InStrRev(Txt, " ", 60)
        c.Offset(0, 1).Value = Left(Txt, Mlr - 1)
        c.Offset(0, 2).Value = Mid(Txt, Mlr + 1, Len(Txt))
        'c.Clear
    Next c
    Exit Sub
fejl:
    If Err.Number = 5 Then
        MsgBox "Teksten er ikke 60 lang, så den kan ikke deles", vbOKOnly + vbExclamation
    End If
End Sub

Fjern ' foran 'c.Clear, hvis B-kolonnen skal slettes, når teksten er fordelt.

Skal kortere tekster bare flyttes til C-kolonnen kan følgende variant bruges:

Sub DelTekstFoer60()

    Dim Mlr As Byte, Txt As String
    For Each c In Selection.Cells
        Txt = c.Value
        Mlr = InStrRev(Txt, " ", 60)
        If Len(Txt) <= 60 Then
            c.Offset(0, 1).Value = c.Value
        Else
            c.Offset(0, 1).Value = Left(Txt, Mlr - 1)
            c.Offset(0, 2).Value = Mid(Txt, Mlr + 1, Len(Txt))
        End If
        c.Clear
    Next c
    Exit Sub

End Sub

Super Mange tak