Buda union ile yapıldı istenilen sütunlar eklenebilir koda.

Private Sub btnAktar_Click()



    Dim i As Byte, topla As Integer

    Dim son As Byte, adres As String

    Dim bul As Range, alan As Range



    Set alan = Union(Range("B:B"), Range("E:E"))

    Range("I3:J" & Rows.Count).ClearContents

'Hafta ici bulmak icin

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

    If son < 3 Then GoTo son

    For i = 3 To son

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

            Set bul = alan.Find(Cells(i, "H").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 = alan.FindNext(bul)

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

            End If

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

            topla = Empty

            Set bul = Nothing

        End If

    Next

'Hafta sonu bulmak icin

    For i = 3 To son

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

            Set bul = alan.Find(Cells(i, "H").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 = alan.FindNext(bul)

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

            End If

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

            topla = Empty

            Set bul = Nothing

        End If

    Next

son:

    On Error Resume Next

    Set bul = Nothing

    Set alan = Nothing

End Sub