Guten Morgen GraFri,

Vielen DANK, Dir ersteinmal für deine Hilfe! Deine Antwort hat mich heute morgen dazu bewogen, den kleinen Quellcode nochmal genau zu durchleuchten. Zuerst habe ich deinen Code so genommen und auf meine Arbeitsblätter angepasst. das Auslesen hat wunderbar geklappt, allerdings habe ich es nicht hinbekommen, dass es mir die Anzahl der Elemente ausgibt. (Ich muss sagen im nachhinnein, hätte ichs mit ner einfachen zählenwenn formel machen können, aber da habe ich nicht dran gedacht ... ärgerlich, naja)

Darum gabs zwei Möglichkeiten: Bei mir nach dem Fehler zu suchen, warum es die Falschen Zellen anspricht oder bei deinem Code zu schauen, wie ich die Anzahl auslese.
Ich habs erstmal mit "meinem" Code probiert und bin tatsächlich auf die Lösung gekommen: currentrange spricht ja den gesamten zusammenhängenden Zellbereich an. Da meine Spalte links und rechts nahtlos an weitere gefüllte Spalten anknüpfte, ist der Fehler entstanden. Also musste ich die Range nur auf die tatsächliche Spalte beschränken. Für diese Errkenntnis allein, habe ich aber auch ein weinig gebraucht, was an meiner fehlenden vba-Erfahrung liegt. Nun also aber der Quellcode wie es bei mir klappt:

Public Sub ElementeAuslesen()
Dim MyDic As Object
Dim arr As Variant
Dim L As Long
Dim N As Long

Set MyDic = CreateObject("Scripting.Dictionary")

N = Sheets("Tabelle1").Cells(1, 4).End(xlDown).Row  'Anzahl gefüllte Zeilen der Spalte D wird ermittelt
arr = Sheets("Tabelle1").Range("D1:D" & N)

For L = 1 To UBound(arr)
    MyDic(arr(L, 1)) = MyDic(arr(L, 1)) + 1
Next
'Ausgeben
Sheets("Tabelle2").Range("A1").Resize(MyDic.Count) = WorksheetFunction.Transpose(MyDic.keys)
Sheets("Tabelle2").Range("B1").Resize(MyDic.Count) = WorksheetFunction.Transpose(MyDic.items)
End Sub