letzte Zeile wieder löschen

Hallo,
vielleicht kann uns jemand helfen:
Es werden Daten in eine Tabelle importiert. Nun kommt es vor, dass in einer Zelle die Zahl der Zeichen bei den importierten Daten über die Spaltenbreite hinausgehen kann. Die Zeichen, die in der Zelle zuviel sind, müssen in die Zelle darunter eingesetzt werden und dafür muss eine neue Zeile eingesetzt werden. Dafür schrieben wir ein Makro:
Dim länge As String
Dim t As Integer


Sub test()
t = 16
n = 255
For Each C In Worksheets(1).Range("C16:C18")
länge = C.Text
länge4 = Left(länge, 30)
If länge4 > "" Then
erste = Left(länge, 30)            'ersten 30 Buchstaben
rest = Mid(länge, 31, n)          'alles ab 31
Range("C" & CInt(t) & "").Select
ActiveCell.Value = erste
Rows(ActiveCell.Row + 1).Insert Shift:=xlDown
Range("C" & CInt(t + 1) & "").Select
ActiveCell.Value = rest
End If
t = t + 1
Next C
End Sub

Bei diesem Makro wird jetzt aber eine leere Zeile zuviel eingefügt. Wie bekommen wir die wieder weg?
Vielen Dank schon mal für die Hilfe.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test2() Dim intZeile As Integer For intZeile = 18 To 16 Step -1 erste = Left(Cells(i, 3), 30) rest = Mid(Cells(i, 3), 31, 255) Cells(i, 3) = erste Cells(i, 3).Offset(1, 0).Insert Cells(i + 1, 3) = rest Next i End Sub

Sub test2() Dim i As Integer Dim erste As String, rest As String With ActiveSheet For i = 18 To 16 Step -1 erste = Left(.Cells(i, 3), 30) rest = Mid(.Cells(i, 3), 31, 255) .Cells(i, 3) = erste .Cells(i, 3).Offset(1, 0).Insert .Cells(i + 1, 3) = rest Next i endwith End Sub

ich hab deinen code erst nicht verstanden, daher habe ich einen eigenen geschrieben.
aber jetzt habe ich mir deinen nochmal angesehen. eigentlich hat nicht mehr viel gefehlt:

Sub test()
t = 16
n = 255
For Each C In Worksheets(1).Range("C16:C18")
    länge = C.Text
    länge4 = Left(länge, 30)

    If länge4 > "" Then
        erste = Left(länge, 30)            'ersten 30 Buchstaben
        rest = Mid(länge, 31, n)          'alles ab 31

        Range("C" & CInt(t) & "").Select
        ActiveCell.Value = erste
        If rest <> "" Then
            Rows(ActiveCell.Row + 1).Insert Shift:=xlDown
            Range("C" & CInt(t + 1) & "").Select
            ActiveCell.Value = rest
        End If
    End If
    t = t + 1
Next C
End Sub

bei mir hats hingehauen...

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread