Soru İzinleri puantaja aktarma

[arrow3441]

Merhabalar alttaki kodu kapalı dosyadan işlem yapıcak şekilde düzenleyebilirmiyiz.Puantaj dosyasında işlem yapıcak Kod çalışıyor fakat dosyayı açıp kapatıyor . yardımlarınızı bekliyorum teşekkürler

Sub Aktar()
Workbooks.Open Filename:=ThisWorkbook.Path & "/İzinTablosu.xlsm"

Dim s2 As Worksheet, Son As Integer, KacGun As Integer, i As Integer

Set s2 = Workbooks(1).Sheets("Sayfa2")
Dim iz As Worksheet: Set iz = Workbooks(2).Sheets("KAYITLAR")

Son = s2.Range("C" & Rows.Count).End(3).Row


For a = 3 To iz.[B65536].End(3).Row
    For satır = 8 To s2.[C65536].End(3).Row
            If iz.Cells(a, 2) <> s2.Cells(satır, 3) Then GoTo 10
        For sütun = 8 To 38
            If s2.Cells(6, sütun) = "" Then GoTo 20
'            If Weekday(CDate(Cells(4, sütun)), 2) > 5 Then GoTo 20
                If iz.Cells(a, 5) <= s2.Cells(6, sütun) And iz.Cells(a, 6) >= s2.Cells(6, sütun) Then
                s2.Cells(satır, sütun) = cesit(iz.Cells(a, 8)) 'iz.Cells(a, 8)
            End If
20:        Next
10: Next
Next
Workbooks(2).Close
End Sub

Function cesit(izin)
If izin = "YILLIK İZİN" Then cesit = "Yİ"
If izin = "RAPORLU" Then cesit = "RP"
If izin = "UCRETSIZ IZIN" Then cesit = "UCS"
End Function

 

[arrow3441]

? yardım eden olursa çok sevinirim

 

[arrow3441]

?

 

[arrow3441]

yokmu çözümü olan ustamız

 

[mukoli]

Ado ile çözüm yapılamazmı

 

[ckarabacak]

Sayın arrow3441 Merhaba

Bende formül ile olanı var izinleri aktarma yapıyor. Sizin puantaj ile aynı formatta değil siz kendinize uyarlayabirsiniz. İzin aktarmalarını makro ile yaparsanız bir örneğini bana da gönderebilirmisiniz. İzin aktarma formülünü makroya çevirecek ustalardan yardım alabilirisiniz

 

[arrow3441]

?