Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
660to664
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
660to664
660to664
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Commandbutton

Commandbutton
01.09.2005 15:41:43
Eleni
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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Commandbutton
01.09.2005 16:04:07
Ramses
Hallo
Wenn du von oben nach unten gehst und zeilen löscht, stimmt irgendwann die Anzahl der Zeilen mit dem Zähler nicht mehr überein
Gehe daher von unten nach oben
For i = endup1 to 8 Step -1
Gruss Rainer
AW: Commandbutton
01.09.2005 16:59:43
Eleni
Hi Rainer,
Danke für den Tipp. Funktioniert.
Ciao, Eleni
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige