Aya göre icra kesintisi aktar

[sedat2161]

Hayırlı akşamlar arkadaşlar. Ekli dosyamın Bordro sayfasında icra kesintisi yaptıktan sonra İCRAA sayfasında bulunan ilgili aya aktarım nasıl yapabilirim. Örneğin Haziran ayı maaşım bitti icra kesintisi yaptığım şahıslardan yapılan kesintiyi İCRAA sayfasındaki haziran ayına aktarmak istiyorum. yardımcı olursanız çok sevinirim. Hayırlı akşamlar. İyi çalışmalar.

 

[Korhan Ayhan]

İcra tutarı olan bütün personelinizin isimlerini "İCRAA" sayfasına ekledikten sonra aşağıdaki kodu kullanabilirsiniz.

Option Explicit

Sub Icra_Aktar()
    Dim S1 As Worksheet, S2 As Worksheet, Ay As String
    Dim Son As Long, X As Long, Personel_Bul As Range, Ay_Bul As Range
   
    Set S1 = Sheets("BORDRO")
    Set S2 = Sheets("İCRAA")
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row - 4
    Ay = S1.Range("R3")
       
    For X = 6 To Son
        If S1.Cells(X, "N") <> "" Then
            Set Personel_Bul = S2.Range("C:C").Find(S1.Cells(X, "C"), , , xlWhole)
            If Not Personel_Bul Is Nothing Then
                Set Ay_Bul = S2.Range("A2:X2").Find(Ay, , , xlWhole)
                If Not Ay_Bul Is Nothing Then
                    S2.Cells(Personel_Bul.Row, Ay_Bul.Column) = S1.Cells(X, "N")
                End If
            End If
        End If
    Next
   
    Set Personel_Bul = Nothing
    Set Ay_Bul = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
   
    MsgBox Ay & " ayı icra verileri aktarılmıştır."
End Sub

 

[sedat2161]

İcra tutarı olan bütün personelinizin isimlerini "İCRAA" sayfasına ekledikten sonra aşağıdaki kodu kullanabilirsiniz.

Option Explicit

Sub Icra_Aktar()
    Dim S1 As Worksheet, S2 As Worksheet, Ay As String
    Dim Son As Long, X As Long, Personel_Bul As Range, Ay_Bul As Range
  
    Set S1 = Sheets("BORDRO")
    Set S2 = Sheets("İCRAA")
  
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row - 4
    Ay = S1.Range("R3")
      
    For X = 6 To Son
        If S1.Cells(X, "N") <> "" Then
            Set Personel_Bul = S2.Range("C:C").Find(S1.Cells(X, "C"), , , xlWhole)
            If Not Personel_Bul Is Nothing Then
                Set Ay_Bul = S2.Range("A2:X2").Find(Ay, , , xlWhole)
                If Not Ay_Bul Is Nothing Then
                    S2.Cells(Personel_Bul.Row, Ay_Bul.Column) = S1.Cells(X, "N")
                End If
            End If
        End If
    Next
  
    Set Personel_Bul = Nothing
    Set Ay_Bul = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
  
    MsgBox Ay & " ayı icra verileri aktarılmıştır."
End Sub

Çok teşekkür ederim Korhan Ayhan bey emeğinize sağlık.

 

[sedat2161]

İcra tutarı olan bütün personelinizin isimlerini "İCRAA" sayfasına ekledikten sonra aşağıdaki kodu kullanabilirsiniz.

Option Explicit

Sub Icra_Aktar()
    Dim S1 As Worksheet, S2 As Worksheet, Ay As String
    Dim Son As Long, X As Long, Personel_Bul As Range, Ay_Bul As Range
  
    Set S1 = Sheets("BORDRO")
    Set S2 = Sheets("İCRAA")
  
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row - 4
    Ay = S1.Range("R3")
      
    For X = 6 To Son
        If S1.Cells(X, "N") <> "" Then
            Set Personel_Bul = S2.Range("C:C").Find(S1.Cells(X, "C"), , , xlWhole)
            If Not Personel_Bul Is Nothing Then
                Set Ay_Bul = S2.Range("A2:X2").Find(Ay, , , xlWhole)
                If Not Ay_Bul Is Nothing Then
                    S2.Cells(Personel_Bul.Row, Ay_Bul.Column) = S1.Cells(X, "N")
                End If
            End If
        End If
    Next
  
    Set Personel_Bul = Nothing
    Set Ay_Bul = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
  
    MsgBox Ay & " ayı icra verileri aktarılmıştır."
End Sub

Hayırlı sabahlar arkadaşlar.
Korhan Ayhan hocamızın yazdığı kodu ekli dosyamda uygulamaya çalıştım. Bir türlü uyarlayamadım. Yardımcı olursanız çok sevinirim.

 

[Korhan Ayhan]

Dosyanız sonradan neden değişti anlamadım. Sanırım öğrenmek adına bu yöntemi seçtiniz.

Yeni dosyanıza uygun kod;

Sub Düğme1_Tıkla()
    Dim S1 As Worksheet, S2 As Worksheet, Ay As String
    Dim Son As Long, X As Long, Personel_Bul As Range, Ay_Bul As Range

    Set S1 = Sheets("BORDRO")
    Set S2 = Sheets("İCRAA")

    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
    Ay = S1.Range("P3")

    For X = 7 To Son
        If S1.Cells(X, "M") <> "" Then
            Set Personel_Bul = S2.Range("C:C").Find(S1.Cells(X, "D"), , , xlWhole)
            If Not Personel_Bul Is Nothing Then
                Set Ay_Bul = S2.Range("A2:W2").Find(Ay, , , xlWhole)
                If Not Ay_Bul Is Nothing Then
                    S2.Cells(Personel_Bul.Row, Ay_Bul.Column) = S1.Cells(X, "M")
                End If
            End If
        End If
    Next
  
    Set Personel_Bul = Nothing
    Set Ay_Bul = Nothing
    Set S1 = Nothing
    Set S2 = Nothing

    MsgBox Ay & " ayı icra verileri aktarılmıştır."
End Sub

 

[sedat2161]

Dosyanız sonradan neden değişti anlamadım. Sanırım öğrenmek adına bu yöntemi seçtiniz.

Yeni dosyanıza uygun kod;

Sub Düğme1_Tıkla()
    Dim S1 As Worksheet, S2 As Worksheet, Ay As String
    Dim Son As Long, X As Long, Personel_Bul As Range, Ay_Bul As Range

    Set S1 = Sheets("BORDRO")
    Set S2 = Sheets("İCRAA")

    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
    Ay = S1.Range("P3")

    For X = 7 To Son
        If S1.Cells(X, "M") <> "" Then
            Set Personel_Bul = S2.Range("C:C").Find(S1.Cells(X, "D"), , , xlWhole)
            If Not Personel_Bul Is Nothing Then
                Set Ay_Bul = S2.Range("A2:W2").Find(Ay, , , xlWhole)
                If Not Ay_Bul Is Nothing Then
                    S2.Cells(Personel_Bul.Row, Ay_Bul.Column) = S1.Cells(X, "M")
                End If
            End If
        End If
    Next
 
    Set Personel_Bul = Nothing
    Set Ay_Bul = Nothing
    Set S1 = Nothing
    Set S2 = Nothing

    MsgBox Ay & " ayı icra verileri aktarılmıştır."
End Sub

Hocam daha önceki işkur maaş bordrosuydu bu işe muhtar maaş bordrosu formatları farklı idi uyarlamaya çalıştım yapamadım çok teşekkür ederim. ALLAH razı olsun. Hayırlı günler.