sn feraz ve sn halil üstadım merhaba,
aslında ocak ayından aralık ayına kadar olacak. ben formülle olursa kalan kısmı kendim tamamlarım düşüncesiyle örnek bir sayfa eklemiştim.  kod ile daha güzel olmuş. 
ocak...aralık ayına kadar ayrı ayrı sayfalar oluşturdum. kodu bu haliyle uygulama imkanı varmı acaba, 

ilginiz ve yardımlarınız için teşekkürler
saygılar

Rica ederiz, alttaki kodu deneyin.Aslında dizi formülleriylede olabilr tam bilmiyorum dizi formül olaylarını karışık yani.
Aslında koda tıklayınca isimleri otomatikte getirilebilir sıralı şekilde.

Private Sub btnAktar_Click()



    Dim syf As Worksheet

    Dim i As Byte, topla As Integer

    Dim son As Byte, adres As String

    Dim bul As Range

    

'Hafta ici bulmak icin

    With ActiveSheet

        Application.ScreenUpdating = False

        .Range("B3:C" & Rows.Count).ClearContents

        son = .Cells(Rows.Count, "A").End(3).Row

        If son < 3 Then GoTo son

  

        For i = 3 To son

            For Each syf In Worksheets

                If syf.Name <> .Name Then

                    If .Cells(i, "A").Value <> "" Then

                        Set bul = syf.Range("B:B").Find(.Cells(i, "A").Value, , , 1)

                        If Not bul Is Nothing Then

                            adres = bul.Address

                            Do

                            If Weekday(bul.Offset(0, -1), 2) < 6 Then topla = topla + 1

                                Set bul = syf.Range("B:B").FindNext(bul)

                            Loop While Not bul Is Nothing And bul.Address <> adres

                        End If

                    End If

                End If

            Next

            .Cells(i, "B").Value = IIf(topla > 0, topla, "")

            topla = Empty

            Set bul = Nothing

        Next

'Hafta sonu bulmak icin

        For i = 3 To son

            For Each syf In Worksheets

                If syf.Name <> .Name Then

                    If .Cells(i, "A").Value <> "" Then

                        Set bul = syf.Range("B:B").Find(.Cells(i, "A").Value, , , 1)

                        If Not bul Is Nothing Then

                            adres = bul.Address

                            Do

                            If Weekday(bul.Offset(0, -1), 2) >= 6 Then topla = topla + 1

                                Set bul = syf.Range("B:B").FindNext(bul)

                            Loop While Not bul Is Nothing And bul.Address <> adres

                        End If

                    End If

                End If

            Next

            .Cells(i, "C").Value = IIf(topla > 0, topla, "")

            topla = Empty

            Set bul = Nothing

        Next

        MsgBox "islem tamamlandi...", vbInformation, "Bilgi"

son:

        Application.ScreenUpdating = True

    End With

    On Error Resume Next

    Set bul = Nothing

    Set syf = Nothing



End Sub

Bu dosyadada butona tıklamanız yeterli ay olan sayfalardaki isimleri benzersiz ve sıralı olarak sayfaya alıp sayıları getirir.

sn feraz, 
eklediğiniz örnek tam da istediğim gibi,
yardımlarınız için teşekkür ederim,
elinize, emeğinize ve yüreğinize sağlık

saygılarımla
Hüsem Doğan

Rica ederiz,kolay gelsin.

bu da recordset yöntemiyle dilerim işinize yarar
1 - referanslardan microsoft ActiveX Data Objects xx Library eklenecek
2 - buton kodu:

Dim SQL, TbU As String



Dim ADO_RS As ADODB.Recordset

Dim ADO_CN As ADODB.Connection

        

Application.ScreenUpdating = False

    

'Hafta ici bulmak icin

    With ActiveSheet

        .Range("A3:C" & Rows.Count).ClearContents

        'hy burda sayfalardan birleştirme sorgusu oluşturulacak

        For Each syf In Worksheets

            If syf.Name <> .Name Then

            TbU = TbU & "Union all " & "SELECT F1 as NobetTrh, F2 as Nobetci FROM [" & syf.Name & "$A3:B] "

            End If

        Next

    

    End With

    TbU = Mid(TbU, 11)

'hy birleşik sorgudan gerekli veri alınacak

SQL = "SELECT TbU.Nobetci, Sum(IIf(Weekday([NobetTrh],2)<6,1,0)) AS Hftici, Sum(IIf(Weekday([NobetTrh],2)>5,1,0)) AS HftSon " & _

      "FROM(" & TbU & ")  As TbU " & _

      "GROUP BY TbU.Nobetci " & _

      "HAVING (((TbU.Nobetci)<>''));"



Set ADO_RS = New ADODB.Recordset

Set ADO_CN = New ADODB.Connection



ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _

                          ";extended properties=""excel 8.0;hdr=no"""

ADO_CN.Open

ADO_RS.Open SQL, ADO_CN, 3, 1

'

'  Eğer Hiç Kayıt Yoksa

If ADO_RS.RecordCount = 0 Then

    ADO_RS.Close

    ADO_CN.Close

    Set ADO_RS = Nothing

    Set ADO_CN = Nothing

    MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"

    Exit Sub

    End If

ADO_RS.MoveLast

ADO_RS.MoveFirst

 Sheets("Toplam Liste").Range("A3").CopyFromRecordset ADO_RS





ADO_RS.Close

ADO_CN.Close

Set ADO_RS = Nothing

Set ADO_CN = Nothing

son:

        Application.ScreenUpdating = True



End Sub

düzeltilmiş dosya