Makro funktioniert nicht aus pers. Arbeitsmappe
emem2404
nun habe ich hier das tolle Script erhalten und das funktioniert tatellos, solange das Makro direkt aus der Arbeitsmappe gestartet wird, sobald ich das Makro in meiner persönlichen Arbeitsmappe speichere und von dort ausführe, hängt es sich immer bei Zeile:
LRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
auf. Ich bekomme die Meldung: Laufzeitfeler '424' Objekt erforderlich
Ich finde den Fehler nicht. Kann mir jemand sagen, was ich falsch mache?
Vielen lieben Dank!
Hier das Makro:
Sub Start_Beispiel()
Dim oDic(1 To 5) As Object
Dim meAr()
Dim A&, LRow&
Dim tmpText$
For A = 1 To 5
Set oDic(A) = CreateObject("Scripting.Dictionary")
Next A
With Tabelle1
meAr = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 5)
End With
For A = 1 To UBound(meAr)
tmpText = meAr(A, 1) & meAr(A, 2)
If oDic(1).Exists(tmpText) Then
oDic(3)(tmpText) = oDic(3)(tmpText) + meAr(A, 3)
oDic(4)(tmpText) = oDic(4)(tmpText) + meAr(A, 4)
oDic(5)(tmpText) = oDic(5)(tmpText) + meAr(A, 5)
Else
oDic(1)(tmpText) = meAr(A, 1)
oDic(2)(tmpText) = meAr(A, 2)
oDic(3)(tmpText) = meAr(A, 3)
oDic(4)(tmpText) = meAr(A, 4)
oDic(5)(tmpText) = meAr(A, 5)
End If
Next A
With Tabelle2
LRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
If LRow > 2 Then
.Range("A2:E2").Resize(LRow - 1).Clear
End If
.Range("A2").Resize(oDic(1).Count) = WorksheetFunction.Transpose(oDic(1).Items)
.Range("B2").Resize(oDic(2).Count) = WorksheetFunction.Transpose(oDic(2).Items)
.Range("C2").Resize(oDic(3).Count) = WorksheetFunction.Transpose(oDic(3).Items)
.Range("D2").Resize(oDic(4).Count) = WorksheetFunction.Transpose(oDic(4).Items)
.Range("E2").Resize(oDic(5).Count) = WorksheetFunction.Transpose(oDic(5).Items)
.Select
End With
End Sub
Gruß
MARTIN
Anzeige