Clever-Excel-Forum

Hallo,

ich habe ein Problem und finde irgendwie keine Lösung.

Ich habe eine Tabelle, an der in Spalte 14 immer Werte mit einem Komma stehen.

Per Makro suche ich diese Zeile und Excel soll mir die unter die bestehende Zeile kopieren.

Mit dem Makro:

Dim LR As Long, i As Long, A As Integer
Application.ScreenUpdating = False
With Sheets("Testblatt")
If .FilterMode Then .ShowAllData ' Autofilter alle
LR = .Cells(.Rows.Count, "B").End(xlUp).Row 'letzte Zeile der Spalte
For i = 2 To LR
If InStr(.Cells(i, 14), ",") > 0 Then
.Range(.Cells(i, 1), .Cells(i, 14)).Select
Selection.Copy
Selection.Insert Shift:=xlDown
End If
Next
End With

macht er es zwar, allerdings verdoppelt er mir dann immer wieder die gleiche Zeile.

Wo liegt der Fehler?

Natürlich bei mir, da das makro die Zeile 280 als erstes findet, die Zeile 280 als Zeile 281 einfügt, dann als nächstes die Zeile 281 findet, diese als Zeile 282 einfügt usw.

Er soll aber nach dem kopieren quasi einfach in der Liste weitersuchen und die nächste kopieren....

Viele Grüße
Andreas

Hallo,

so sollte es gehen:

Code:
Dim LR As Long, i As Long, A As Integer

    Application.ScreenUpdating = False

    With Sheets("Testblatt")

    If .FilterMode Then .ShowAllData ' Autofilter alle

        LR = .Cells(.Rows.Count, "B").End(xlUp).Row 'letzte Zeile der Spalte

        For i = 2 To LR

            If InStr(.Cells(i, 14), ",") > 0 Then

          .Range(.Cells(i, 1), .Cells(i, 14)).Select

        Selection.Copy

    Selection.Insert Shift:=xlDown

    i = i + 1

  End If

  Next

End With

Er muss nach einem "Fund" immer eine Zeile weiterspringen, sonst wird die kopierte Zeile wieder gefunden.

Grüße

NobX

Moin!
Ohne mir die Logik näher angeschaut zu haben:
Hilft statt
For i = 2 To LR
For i = LR To 2 Step -1
?

Gruß Ralf

Hallo

sieht so nach Code von mir aus.

Sowas macht man immer von unten nach oben
Außerdem kann man in 99% auf Select verzichten

also so

Code:
    Dim LR As Long, i As Long, A As Integer

    Application.ScreenUpdating = False

    With Sheets("Testblatt")

        If .FilterMode Then .ShowAllData ' Autofilter alle

        LR = .Cells(.Rows.Count, "B").End(xlUp).Row 'letzte Zeile der Spalte

        For i = LR To 2 Step -1

            If InStr(.Cells(i, 14), ",") > 0 Then

                With .Range(.Cells(i, 1), .Cells(i, 14))

                    .Offset(1, 0).Insert Shift:=xlDown

                    .Copy .Offset(1, 0)

                End With

            End If

        Next

    End With

LG UweD

Vielen Dank an alle,

es funktioniert.

@UWE: Ja, ein Teil des Codes ist von Dir.

Den kann ich eigentlich für irgendetwas immer brauchen Smile

Viele Grüße
Andreas

ari-2001

NobX

RPP63

UweD

ari-2001