Hi Forum,
Habe einen Button in einem Tabellenblatt mit dem unten stehenden Code "Auswerten" belegt. Dieser Code guckt in einer bestimmten Spalte nach Datumseinträgen und verschiebt die Zeilen entsprechend ihres Monats in ein separates Monatsblatt. Das Makro funktioniert soweit, allerdings lässt er manchmal ein paar Zeieln stehen (warum, weiß ich nicht). Ich muss dann mehrmals auf den Button klicken, bis er alle Zeilen ins entsprechende Tabellenblatt verschoben hat. Nach dem Code "Auswerten" möchte ich einen anderen Code zusätzlich ablaufen lassen. Bin für jeden Vorschlag zur Lösung des Problems offen.
Danke, Eleni
"Auswerten"
Dim endup1 As Integer
Dim i As Integer
endup1 = ThisWorkbook.Sheets("Aktuell").Range("A65536").End(xlUp).Row
Application.EnableEvents = False
For i = 8 To endup1
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.01.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Januar").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.02.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Februar").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.03.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("März").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.04.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("April").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If

If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.05.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Mai").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If

If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.06.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Juni").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If

If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.07.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Juli").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If

If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.08.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("August").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If

If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.09.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("September").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If

If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.10.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Oktober").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If

If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.11.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("November").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If

If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.12.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Dezember").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
Next i
Application.EnableEvents = True