Makro funktioniert nach kopieren nicht mehr
23.07.2019 14:51:48
Jenny
zuerst einmal ich muss gestehen, mein Makro ist mit wenigen VBA Kenntnissen und ein paar Tipps aus Foren selbst zusammengebastelt.
Aber an einer Stelle komme ich nicht weiter.
Prinzipiell geht es darum ich füge Texte in Spalte A ein, bestimmte Texte davon werden dann automatisch nach Spalte B und C kopiert und Spalte A wird weder geleert.
Nur manchmal gehe ich hin und schneide 2 in der selben Zeile liegenden Zellen in Spalte B und C aus und füge den Inhalt in Spalte B und C der Tabelle 2 ein.
Dann bekomme ich die Meldung "Die Methode 'Range' für das Obejekt '_Worksheet' ist fehlgeschlagen und ich kann das Makro nicht mehr benutzen, bis ich Excel geschlossen und wieder geöffnet habe.
Gibt es da eine Lösung, dass ich die Zeilen ausschneiden und einfügen kann ohne dass das Makro crasht?
Danke
Jenny
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i As Long, StartZeile As Long, EndZeile As Long, letzteLeereZeile As Long
Application.EnableEvents = False
With Sheet1
' StartZeile = InputBox("Ab welcher Zeile soll gestartet werden?", "Abfrage1")
StartZeile = 3
ANFANG:
EndZeile = .Cells(Rows.Count, 1).End(xlUp).Row
For i = StartZeile To EndZeile Step 6
If StartZeile = 3 Then
If letzteLeereZeile = 0 Then
letzteLeereZeile = .Cells(Rows.Count, 2).End(xlUp).Row + 1
Else
letzteLeereZeile = .Cells(Rows.Count, 2).End(xlUp).Row + 1
End If
.Cells(letzteLeereZeile, 2).Value = .Cells(i, 1).Value
Else
If StartZeile = 5 Then
If letzteLeereZeile = 0 Then
letzteLeereZeile = .Cells(Rows.Count, 3).End(xlUp).Row + 1
Else
letzteLeereZeile = .Cells(Rows.Count, 3).End(xlUp).Row + 1
End If
.Cells(letzteLeereZeile, 3).Value = .Cells(i, 1).Value
End If
End If
Next i
If StartZeile = 5 Then
.Range(.Cells(1, 1), Cells(Rows.Count, 1)).Value = ""
Else
StartZeile = 5
letzteLeereZeile = 0
GoTo ANFANG
End If
End With
Application.EnableEvents = True
End Sub
Anzeige