Kod Birleştirme

Katılım
25 Mayıs 2010
Mesajlar
480
Excel Vers. ve Dili
Office 2019
64bit
Tr
Win 10
Altın Üyelik Bitiş Tarihi
12-07-2024
Merhaba Sn. Yetkililer,

TUM PERSONEL sayfasında bulunan Artiİşareti Makrosunun altına Makro Kaydet yöntemiyle eklediğim TumPersonelFormulleri kodunu + butonu ile birlikte çalıştırabilir miyim?



Kod:
Sub Artıİşareti1_Tıkla()
Dim tum As Worksheet, brd As Worksheet
Set brd = Sheets("BORDRO")
Set tum = Sheets("TUM_PERSONEL")
son1 = tum.Cells(Rows.Count, "A").End(3).Row + 1 'tüm
son2 = brd.Cells(Rows.Count, "A").End(3).Row 'brd
sayi = 0
For i = 11 To son2
    If brd.Cells(i, "A") > "" Then
    ArananTc = brd.Cells(i + 1, "B")
    say = WorksheetFunction.CountIf(tum.Range("B4:B" & son1 - 1), ArananTc)
        If say = 0 Then
        tum.Cells(son1, "A") = Val(tum.Cells(son1 - 1, "A")) + 1
        tum.Cells(son1, "B") = brd.Cells(i + 1, "B")
        tum.Cells(son1, "C") = brd.Cells(i, "B")
        tum.Cells(son1, "J") = brd.Cells(i, "D")
        tum.Cells(son1, "K") = brd.Cells(i + 1, "D")
        son1 = son1 + 1
        sayi = sayi + 1
        End If
    End If
Next i
If sayi > 0 Then
MsgBox sayi & " Yeni Personel Eklenmiştir."
Else
MsgBox "Yeni Personel Yoktur."
End If
End Sub

Sub TumPersonelFormulleri()
'
' TumPersonelFormulleri Makro
'

'
    Range("D4").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP(RC[-2],PERSONEL_LISTESI!C[-2]:C,3,0),"""")"
    Range("D4").Select
    Selection.AutoFill Destination:=Range("D4:D999")
    Range("D4:D999").Select
    Range("G4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(MID(RC[5],3,5)=""00012"",IF(LEFT(MID(SUBSTITUTE(RC[5],RIGHT(RC[5],11),""""),10,99)+0,1)=""9"",MID(MID(SUBSTITUTE(RC[5],RIGHT(RC[5],11),""""),10,99)+0,2,99),MID(SUBSTITUTE(RC[5],RIGHT(RC[5],11),""""),10,99)+0)+0,"""")"
    Range("G4").Select
    Selection.AutoFill Destination:=Range("G4:G999")
    Range("G4:G999").Select
    Range("H4").Select
    ActiveCell.FormulaR1C1 = "=IF(MID(RC[4],3,5)=""00012"",RIGHT(RC[4],8),"""")"
    Range("H4").Select
    Selection.AutoFill Destination:=Range("H4:H999")
    Range("H4:H999").Select
End Sub
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,269
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

İlk makronuzda Next i satırının altına aşağıdaki satırı yazıp diğer makronuzun çalışmasını sağlayabilirsiniz.

Call TumPersonelFormulleri
 
Katılım
25 Mayıs 2010
Mesajlar
480
Excel Vers. ve Dili
Office 2019
64bit
Tr
Win 10
Altın Üyelik Bitiş Tarihi
12-07-2024
Merhaba,

İlk makronuzda Next i satırının altına aşağıdaki satırı yazıp diğer makronuzun çalışmasını sağlayabilirsiniz.

Call TumPersonelFormulleri
teşekkür ederim. saygılar hocam
 
Üst