İzin takibi yapma 2020

[yyhy]

İzin takibi yapmak için örnek dosyamda bulunan verileri macro yardımı ile şarta bağlı olarak sayfalarına aktarmak için yardımcı olabilir misiniz?

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodu kullanabilirsiniz.

Sub Kopyala()
    Dim syf As Worksheet
    Dim Say As Long
    Application.DisplayAlerts = False
    Set syf = Worksheets("izinTakip")
    Say = syf.Cells(Rows.Count, "A").End(3).Row
    syf.Range("A170:E" & Say).Copy
    Worksheets(syf.Range("C166").Text).Range("A" & syf.Range("E166").Text).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
End Sub

Not: Lütfen bundan sonra örnek dosyanızı sıkıştırmadan ekleyiniz.

 

[yyhy]

Doğrudur sayın dalgalikur dosyayı sıkıştırmadan yüklemeyi denedim ama bir türlü yükleme yapmadı. Yükleme yapmayınca bende sıkıştırıp yükleme yaptım, o zaman yükledi. İnşallah sorun bizim explorer ile ilgilidir. Saygılar ve teşekkürler. Macro yu deneyeceğim.

 

[yyhy]

Ayrıca
istenen sayfa yoksa ve de aktarma işlemi bitince de bir uyarı verilebilir mi?

 

[Muzaffer Ali]

Evet. Aşağıdaki kodlar ile olur.

Sub Kopyala()
    Dim syf As Worksheet
    Dim Bak As Worksheet
    Dim Say As Long
    Dim SayfaVar As Boolean
    Set syf = Worksheets("izinTakip")
    For Each Bak In Worksheets
        If Bak.Name = syf.Range("C166").Text Then
            SayfaVar = True
            Exit For
        End If
    Next
    If SayfaVar = False Then
        MsgBox "'" & syf.Range("C166").Text & "' adlı sayfa bulunamıyor."
        Exit Sub
    End If
    Say = syf.Cells(Rows.Count, "A").End(3).Row
    syf.Range("A170:E" & Say).Copy
    Worksheets(syf.Range("C166").Text).Range("A" & syf.Range("E166").Text).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    MsgBox "İşlem tamamlandı."
End Sub

 

[yyhy]

Sayın dalgalikur ihtiyaca cevap verdi. Emeğinize sağlık çok teşekkür ederim.