Hallo! Habe die beiden Makros mal verschmolzen. Habe dabei aber gleich den Namen getestet und nicht noch extra in eine Liste gespeichert. Falls das später nochmal benötigt wird, einfach wieder einfügen. Es werden erst alle Blätter für den Mitarbeiter durchsucht und dann der nächste Mitarbeiter genommen.  Ich hoffe mal, dass es nicht wieder Probleme wie beim letzten Post bei mehrfacher Auflistung des selben Datums gibt (der Code ist dahingehend ja identisch und beendet bei exit for die Datumssuche). Bei Fragen einfach melden. VG

Sub berechnung()

Dim Spalte As Integer, Zeile As Integer, NrDatum As Integer, Spalte1 As Integer
Dim Datum As Date
Dim Anzahl As Integer, Arbeiter As Integer
Dim MaxArbeiter As Integer, MaxTage As Integer
Dim Eingabe As String
Dim Zelle As String
Dim Festmacher As Integer, Mal As Integer, Pos As Integer
Dim ws As Worksheet

Eingabe = InputBox("Anzahl der Mitarbeiter", "Mitarbeiter")     'Fragt die Anzahl der Mitarbeiter ab
If Eingabe = "" Or Not IsNumeric(Eingabe) Then Exit Sub
MaxArbeiter = CInt(Eingabe)                                     'Eingabe wird zu Integer umgewandelt und als MaxArbeiter gespeichern

Eingabe = InputBox("Anzahl der Tage im Monat", "Monat")         'Fragt die Anzahl der Tage in dem jeweiligen Monat an
If Eingabe = "" Or Not IsNumeric(Eingabe) Then Exit Sub         'Prüfung ob etwas eingegeben wurde und ob Eingabe eine Zahl ist
MaxTage = CInt(Eingabe)                                         'Eingabe wird zu Integer umgwandelt und als MaxTage gespeichert

For Zeile = 4 To MaxArbeiter + 4                                'Schleife beginnt bei der ersten Mitarbeiter-NR in Zeile 4 bis hin zum letzten MA
    Arbeiter = Worksheets("April_2016").Cells(Zeile, 5).Value     'merkt sich den Wert aus Spalte 5, die Mitarbeiter-NR fortlaufend bis zum letzten Eintrag

        For Spalte = 6 To MaxTage + 6                                 'alle Spalten in April_2016 durchlaufen bis zum letzten Tag
            Datum = Worksheets("April_2016").Cells(3, Spalte).Value     'Datum festlegen
            
            For Each ws In Worksheets
                If Mid(ws.Name, 1, 6) = "Schiff" Then
                    For NrDatum = 6 To 23                                       'Datum wird gesucht
                        If Worksheets(ws.Name).Cells(NrDatum, 1).Value = Datum Then Exit For   'Wenn an dieser Stelle das eingetragene Datum gleich dem Datum aus April_2016 ist Exit
                    Next NrDatum
                    Anzahl = 0
    
                    For Spalte1 = 5 To 15                                           'die Spalten Fema und Loma
                        Zelle = Worksheets(ws.Name).Cells(NrDatum, Spalte1).Value        'durchläuft alle Zellen und untersucht bzw. merkt sich den Wert
                        If Zelle <> "" Then                                                 'wenn Zelle ungleich 0 bzw. etwas drin steht
                            Pos = InStr(1, Zelle, "/", 1)                                   '1=textbasierter Vergleich, sucht nach / und merkt sich die Position
                            If Pos = 0 Then                                                     'wenn Pos=0, also kein / vorhanden
                                Festmacher = CInt(Zelle)                                          'übernimmt die Arbeiter-NR die in der Zelle steht
                                Mal = 1                                                           'wird nur einmal eingesetzt, da kein /
                            Else                                                                'wenn / vorhanden ist
                                Festmacher = CInt(Mid(Zelle, 1, Pos - 1))                         'Mid gibt Zeichenfolge aus der Zelle zurück; Pos-1 da Arbeiter-NR vor dem / steht
                                Mal = CInt(Mid(Zelle, Pos + 1))                                   'Pos+1 da Anzahl an Einsätzen an diesem Tag hinter / steht
                            End If
                            If Festmacher = Arbeiter Then Anzahl = Anzahl + Mal           'Wenn der Festmacher gleich Arbeiter ist wird Anzahl um Mal erhöht
                        End If
                    Next Spalte1                                                    'geht über zur nächsten Spalte
                End If
            Next ws

            Worksheets("April_2016").Cells(Zeile, Spalte).Value = Anzahl    'an der entsprechenden Stelle in der Liste wird die Anzahl eingetragen

        Next Spalte
Next Zeile                                                          'Schleife wird so lange durchlaufen bis MaxArbeit und MaxTage durchlaufen wurde

End Sub