komma finden und diese Zeile kopieren

[ari-2001]

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

[NobX]

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

[RPP63]

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

[UweD]

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

[ari-2001]

Vielen Dank an alle,

es funktioniert.

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

Den kann ich eigentlich für irgendetwas immer brauchen


Viele Grüße
Andreas