Hallo kompetentes Forum :),

ich habe bereits folgenden Code erhalten:

Sub kunzi() 

Dim objDic As Object 
Dim c As Range 
Dim vntKeys As Variant 
Dim vntItems As Variant 

Set objDic = CreateObject("Scripting.Dictionary") 

For Each c In Range("B1:B" & Cells(Rows.Count, 1).End(xlUp).Row) 

If Not objDic.exists(c.Value) Then 
    objDic.Add c.Value, c.Offset(, 1).Value 
Else 
    objDic(c.Value) = objDic(c.Value) & "," & c.Offset(, 1).Value 
End If 
Next 
vntKeys = objDic.keys 
vntItems = objDic.items 

Range("B1:C" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents 
Cells(1, 2).Resize(UBound(vntKeys) + 1) = WorksheetFunction.Transpose(vntKeys) 
Cells(1, 3).Resize(UBound(vntItems) + 1) = WorksheetFunction.Transpose(vntItems) 


End Sub 

Das Ergebnis der Ausfuehrung des Codes sieht so aus

Vorher Codeausfuehrung:

Spalte A                     Spalte B                   Spalte C
 A1                            600                         a1
 A1                            600                         a2
 A1                            600                         a3
 A2                            700                         a4
 A2                            700                         a5


Nach Codeausfuerhung:

Spalte A                     Spalte B                      Spalte C
 A1                            600                         a1, a2, a3
 A1                            700                          a4, a5
 A1                           
 A2                           
 A2                          

Wo muss ich im Code jetzt was veraendern wenn ne leere Zeile in Spalte B entsteht und ich die entsprechende komplette Zeile geloescht haben will?

Danke im Voraus! Gruss Kunzi