Soru Görevli Olduğu Günlere Göre İsim Getirme

[sirkülasyon]

Eklenmiş dosyamın Personel Giriş Sayfasında
Personel Adı Soyadı, Unvanı ve bir ay içerisinde görev alacağı günler yazılı.
Çizelge Sayfasında
Yıl ve Ay seçildiği zaman oluşan çizelgeye göre
- Personelin Adı Soyadını
- Personelin Unvanını
- Personelin Görevli İse Görevli olduğu günleri getirmek istiyorum.
Rica etsem yardımcı olabilir misiniz?

 

[Necdet]

Merhaba,

Sorunuzu ben pek anlamadım, olması gereken durumu dosyanızda belirtirseniz, anlaşılması daha iyi olur.

 

[sirkülasyon]

olması gereken şekli ile ekte necdet abi

 

[YUSUF44]

Mevcut aktar makrosunu aşağıdakiyle değiştirip dener misiniz?

Option Explicit
Sub aktar()
Dim Ay As Byte, İlk_Gün As Date, Son_Gün As Date, Tarih As Date, Satır As Byte
Dim s1 As Worksheet, s2 As Worksheet
Dim sonB As Integer, sonsut As Integer, i As Integer, j As Integer, k As Integer, yeni As Integer
Range("F5:AH5").ClearContents
Satır = 6

Select Case Range("C3")
Case Is = "Ocak": Ay = 1
Case Is = "Şubat": Ay = 2
Case Is = "Mart": Ay = 3
Case Is = "Nisan": Ay = 4
Case Is = "Mayıs": Ay = 5
Case Is = "Haziran": Ay = 6
Case Is = "Temmuz": Ay = 7
Case Is = "Ağustos": Ay = 8
Case Is = "Eylül": Ay = 9
Case Is = "Ekim": Ay = 10
Case Is = "Kasım": Ay = 11
Case Is = "Aralık": Ay = 12
End Select

İlk_Gün = DateSerial(Range("C2"), Ay, 1)
Son_Gün = DateSerial(Range("C2"), Ay + 1, 0)

For Tarih = İlk_Gün To Son_Gün
If Weekday(Tarih, vbMonday) < 6 Then
Cells(5, Satır) = Tarih
Satır = Satır + 1
End If
Next
Set s1 = Sheets("Personel Giriş")
Set s2 = Sheets("Çizelge")
sonB = s1.Cells(Rows.Count, "B").End(3).Row

For i = 3 To sonB
    yeni = s2.Cells(Rows.Count, "B").End(3).Row + 1
    s2.Cells(yeni, "B") = s1.Cells(i, "B")
    s2.Cells(yeni, "E") = s1.Cells(i, "C")
    sonsut = s1.Cells(i, Columns.Count).End(xlToLeft).Column
    For j = 4 To 8
        If s1.Cells(i, j) <> "" Then
            For k = 6 To 28
                If s2.Cells(2, k) = s1.Cells(2, j) Then
                    s2.Cells(yeni, k) = "X"
                End If
            Next
        End If
    Next
Next
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Not: Makroyu, son gönderdiğiniz dosyayı görmeden yazdım.

 

[sirkülasyon]

Yusuf Abi
Ellerine Sağlık. Teşekkür ederim Hayırlı İftarlar Dilerim.
"ÇÖZÜLDÜ"