Hallo Zusammen
und ein Frohes Weihnachtsfest wünsche ich.

Ich habe hier per VBA ein Makro versucht zu entwerfen.
Die Auswertungen erfolgen richtig. Leider läuft es in
der Form so ca. 15 Minuten. Was aus meiner Sicht sehr
lang erscheint, oder????

Würde mich riesig freuen, wenn mir jemand einen anderen
Vorschlag machen könnte, wie ich dieses Makro beschleunige.

Außerdem muss ich dieses Makro auf mehrere Tabellen erweitern.
Hier bräuchte ich auf jeden Fall viel Hilfe.

Das Makro soll folgendes bewirken:

In einer Tabelle sind alle Bruttolohnarten von allen Mitarbeitern
von mehreren Monaten oder Jahren importiert worden. Diese muss
ich nun sortieren und anschließend pro Lohnart und pro Mitarbeiter
summieren.

Ich hoffe ich konnte mich verständlich ausdrücken und würde mich sehr
über eure Hilfe freuen.

Leider ist es nicht möglich diese Tabellen zur Verfügung zu stellen.
Datenschutz...

Bis bald

Uwe

Hier das Makro:

Dim summe As Single, bereich As range, zelle As range, wsszelle, j As Date

j = Now
n = 6 'Zeilenzähler für Pers-Nr. in SozialplanSumme Tabelle
d = 3 'Spaltenzähler für LOA
summe = 0
Set wss = ThisWorkbook.Worksheets("SozialplanSumme")
Set w022 = ThisWorkbook.Worksheets("Mandant022")

'Set bereich = w022.range("A1:A5000")
wsszelle = wss.UsedRange.Rows.Count
wsszelle = wsszelle + 2
wssspalte = wss.UsedRange.Columns.Count
wssspalte = wssspalte + 2
Set bereich = w022.range("A1: A5000")
Do Until d = wssspalte
Do Until n = wsszelle
For Each zelle In bereich
If zelle.Value = wss.range("A" & n).Value And _
zelle.Offset(0, 9) = wss.Cells(2, d) Then
summe = summe + zelle.Offset(0, 11).Value
Else
End If
Next zelle
wss.Cells(n, d) = summe
n = n + 1
summe = 0
Loop
d = d + 1
n = 6
Loop
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
Debug.Print Format(Now - j, "hh:mm:ss")
End Sub