Hallo, 

ich habe eine Liste mit ca. 2000 Materialnr. und dazu die verbrauchte Menge. Das Problem dabei dass jeder Verbrauch extra eingetragen wird und nicht zu den breits vorh. hinzugefügt wird. Insgesamt sind es ca. 200 versch. Mat.Nr.  Ich wollte jetzt ein VBA programm schreiben, dass alle Mengen einer bestimmten Mat. aufsummiert und die nicht benötigten dann löscht, damit jede Mat.Nr. nur noch einmal drinnensteht. Das aufsummieren funktioniert, nur das löschen der nicht benötigten nicht. 

Hier das aufsummieren. 

(Alle Mat.Nr. die gleich sind stehen direkt untereinander)

Dieser Code funktioniert

Sub ListeLeeren()

Dim x As String 'Variable für die Mat.Nr
Dim erg As Integer 'Var. für das aufsummieren der Mengen
Dim i As Integer 'Laufvar. für die Schleife
   

'x die erste Mat.Nr. in der Excelliste zuweisen
x = ActiveSheet.Cells(1, "A").Value


'Schleife über die Komplette Liste
For i = 0 To Tabelle1.Cells(Rows.Count, "A").End(xlUp).Row

    'Wenn die Mat.Nr in der nächsten Zeile die selbe ist wie die aktuelle
    'Dann die Menge in dieser Zeile addieren
    If Cells(i + 1, "A").Value = x Then
        erg = erg + Cells(i + 1, "B").Value
    Else
        'Wenn nicht dann
        'Das aufsummierte Erg in die akt. Zeile in Spalte B schreiben
        Cells(i, "B").Value = erg
        'Die aufsummierte Zeile mit einem X in Spalte C kennzeichnen
        Cells(i, "C").Value = "X"
        
        'Das neue Erg ist nun die Menge der neuen Mat.Nr(Steht in nächster Zeile)
        erg = Cells(i + 1, "B").Value
        'Die neue Mat.Nr. ist nun die Mat.Nr., die in der nächsten Zeile steht
        x = Cells(i + 1, "A").Value
    
    End If
    
Next

Alle Zeilen die in Spalte C nun kein X haben können ja gelöscht werden, da nur die mit einem X aufsummiert wurden. 
Aber wie lösche ich alle Zeilen die kein X in Spalte C haben? 


Dim y As Integer

'Alle unnötigen Zeilen löschen
'

'For y = 1 To Tabelle1.Cells(Rows.Count, "A").End(xlUp).Row

 '   If Cells(y , "C") <> "X" Then
  '      Cells(y, "C").Delete xlShiftUp
   ' End If


'Next

hier hängt sich Excel auf (keine Rückmeldung) 

Vielen Dank