Aktarma

[eminasri]

Bu siteye yeni üyelerden biriyim ama o kadar çok şey kazandırdıki anlatsamam.
Bu konuyu açayımmı açmayayımı diyede çok düşündüm ama yardımcı olursanız çok sevinirim. Çok uğraştım araştırdım ama yapaadım ekli dosyada herşeyi açıkça belirttim yardımcı olursanız sevinirim. Şimdiden herkese teşekkürler.

 

[İhsan Tank]

Bu siteye yeni üyelerden biriyim ama o kadar çok şey kazandırdıki anlatsamam.
Bu konuyu açayımmı açmayayımı diyede çok düşündüm ama yardımcı olursanız çok sevinirim. Çok uğraştım araştırdım ama yapaadım ekli dosyada herşeyi açıkça belirttim yardımcı olursanız sevinirim. Şimdiden herkese teşekkürler.

Merhaba
Sorularınızı lütfen konu içinde açıklamaya özen gösteriniz
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub aktarım_61()
Dim ts, kaplan, trabzonspor
Set ts = Sheets("İZİN KARTI")
Set kaplan = Sheets("İZİN İSTEĞİ VE ONAYI")
If kaplan.Range("J9") = Empty Then Exit Sub
If kaplan.Range("G11") = Empty Then Exit Sub
If kaplan.Range("J11") = Empty Then Exit Sub
If kaplan.Range("J13") = Empty Then Exit Sub
trabzonspor = MsgBox("Kaydı Yapıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
Set ts = Sheets("İZİN KARTI")
Set kaplan = Sheets("İZİN İSTEĞİ VE ONAYI")
trabzonspor = ts.Range("C" & Rows.Count).End(xlUp).Row
ts.Range("C" & trabzonspor + 1) = kaplan.Range("J9")
ts.Range("D" & trabzonspor + 1) = kaplan.Range("G11")
ts.Range("E" & trabzonspor + 1) = kaplan.Range("J11")
ts.Range("G" & trabzonspor + 1) = kaplan.Range("J13")
Application.ScreenUpdating = True
MsgBox "Kaydı Yaptım", , "Bitiş - www.excel.web.tr"
End Sub

 

[Necdet]

Merhaba,

Aşağıdaki kodları deneyiniz.

Sub AKTAR()
    
    Dim i   As Long, _
        Kol As Integer, _
        so  As Worksheet, _
        sk  As Worksheet
        
    Set sk = Sheets("İZİN KARTI")
    Set so = Sheets("İZİN İSTEĞİ VE ONAYI")
    
    sk.Select
    
    If Not so.Range("C7") = "" Then
        Kol = 2
    ElseIf Not so.Range("E7") = "" Then
        Kol = 7
    ElseIf Not so.Range("G7") = "" Then
        Kol = 12
    ElseIf Not so.Range("J7") = "" Then
        Kol = 17
    Else
        MsgBox "Aldığı İzin Türü Belirtilmemiş...."
        Exit Sub
    End If
    
    i = Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
    
    Cells(i, Kol) = so.Range("J13")
    Cells(i, Kol + 1) = so.Range("J9")
    Cells(i, Kol + 2) = so.Range("G11")
    Cells(i, Kol + 3) = so.Range("J11")
    
    MsgBox "Aktarılmıştır..."
    
End Sub

 

[eminasri]

sayın hocam ilginiz için çok teşekkür ederim ama modüle kopyaladım,
ama hata veriyor bi bakarsanız çok sevinirim

 

[eminasri]

Hocam verdiğiniz bilgiler için çok teşekkür ederim.
diğer eksikleri ben burdan tamamladım ellerinize sağlık
çok ama çok teşekkür ederim