Aktar

[eminuslu]

Sevgili dostlar herkese iyi gecelerf ekteki dosyamdaki basit makro aktar deyincesi Mehmet İle Cahit'i aktarıyor.Fakat benim istediğim C6 da bilgi varsa (Mehmet Cahit'i) aktarsın F6 da bilgi varsa (Ahmet Saip) aktarılsın eğer C 6 ile F6 boş ise hiç bilgi aktarmasın (Yani D6 doluysa D7 ve D8)deki bilgileri (G6 doluysa G7 ve G8) deki bilgileri aktarsın yoksa boş geçsin istiyorum dosyam ekte olup bu konuda yardımcı olma gayretinde olan herkese sonsuz teşekkür eder hayırlı geceler dilerim

 

[İhsan Tank]

Sevgili dostlar herkese iyi gecelerf ekteki dosyamdaki basit makro aktar deyincesi Mehmet İle Cahit'i aktarıyor.Fakat benim istediğim C6 da bilgi varsa (Mehmet Cahit'i) aktarsın F6 da bilgi varsa (Ahmet Saip) aktarılsın eğer C 6 ile F6 boş ise hiç bilgi aktarmasın (Yani D6 doluysa D7 ve D8)deki bilgileri (G6 doluysa G7 ve G8) deki bilgileri aktarsın yoksa boş geçsin istiyorum dosyam ekte olup bu konuda yardımcı olma gayretinde olan herkese sonsuz teşekkür eder hayırlı geceler dilerim

Merhaba
Butondaki köprüyü kaldırın ve bu kodu boş bir module kopyalayın.

Option Explicit
Sub şartlı_aktar()
Dim ts, kaplan, trabzonspor, asi, hamsi As Date
Set asi = Sheets("Deneme")
Set kaplan = Sheets("1")
If asi.Range("D6") = Empty And asi.Range("G6") = Empty Then
Exit Sub
ElseIf asi.Range("D6") <> Empty And asi.Range("G6") = Empty Then
ts = kaplan.Range("A" & Rows.Count).End(xlUp).Row
If ts < 10 Then ts = 10
kaplan.Cells(ts, "A") = asi.Range("D7")
kaplan.Cells(ts, "B") = asi.Range("E7")
ElseIf asi.Range("D6") = Empty And asi.Range("G6") <> Empty Then
ts = kaplan.Range("A" & Rows.Count).End(xlUp).Row
If ts < 10 Then ts = 10
kaplan.Cells(ts, "A") = asi.Range("G7")
kaplan.Cells(ts, "B") = asi.Range("H7")
ElseIf asi.Range("D6") <> Empty And asi.Range("G6") <> Empty Then
ts = kaplan.Range("A" & Rows.Count).End(xlUp).Row
If ts < 10 Then ts = 10
kaplan.Cells(ts, "A") = asi.Range("D7")
kaplan.Cells(ts, "B") = asi.Range("E7")
kaplan.Cells(ts + 1, "A") = asi.Range("G7")
kaplan.Cells(ts + 1, "B") = asi.Range("H7")
End If
kaplan.Select
End Sub

 

[eminuslu]

İhsanbey ilgilenip sorumu cevaplandırdığın için çok teşekkür ederim cevap tam istediğim şekilde

 

[İhsan Tank]

İhsanbey ilgilenip sorumu cevaplandırdığın için çok teşekkür ederim cevap tam istediğim şekilde

Rica ederim
:keyif:

 

[eminuslu]

İhsan bey kodları denediğimde bir sorun çıktı sizin affınıza sığınarak soruyu sormak istiyorum aktar sayfamda kaplan ve trabzonspor seçili ise sürekli aktarma yapıyor bunun içinde süre koymak gerekti yani aktar dedikten sonra 2 gün aktarmasın bunun içinde 1 yazılı sayfanın j1 hücresine tarih verip msboxla beni uyarsın dosyam ektedir

 

[İhsan Tank]

İhsan bey kodları denediğimde bir sorun çıktı sizin affınıza sığınarak soruyu sormak istiyorum aktar sayfamda kaplan ve trabzonspor seçili ise sürekli aktarma yapıyor bunun içinde süre koymak gerekti yani aktar dedikten sonra 2 gün aktarmasın bunun içinde 1 yazılı sayfanın j1 hücresine tarih verip msboxla beni uyarsın dosyam ektedir

Merhaba
Kodu bununla değiştirin

Option Explicit
Sub şartlı_aktar()
Dim ts, kaplan, trabzonspor, asi, hamsi As Date
Set asi = Sheets("Deneme")
Set kaplan = Sheets("1")
If kaplan.Range("J1") <> Date And kaplan.Range("J1") <> _
DateSerial(Year(Date), Month(Date), Day(Date) - 1) Then
If asi.Range("D6") = Empty And asi.Range("G6") = Empty Then
Exit Sub
ElseIf asi.Range("D6") <> Empty And asi.Range("G6") = Empty Then
ts = kaplan.Range("A" & Rows.Count).End(xlUp).Row
If ts < 10 Then ts = 10
kaplan.Cells(ts, "A") = asi.Range("D7")
kaplan.Cells(ts, "B") = asi.Range("E7")
ElseIf asi.Range("D6") = Empty And asi.Range("G6") <> Empty Then
ts = kaplan.Range("A" & Rows.Count).End(xlUp).Row
If ts < 10 Then ts = 10
kaplan.Cells(ts, "A") = asi.Range("G7")
kaplan.Cells(ts, "B") = asi.Range("H7")
ElseIf asi.Range("D6") <> Empty And asi.Range("G6") <> Empty Then
ts = kaplan.Range("A" & Rows.Count).End(xlUp).Row
If ts < 10 Then ts = 10
kaplan.Cells(ts, "A") = asi.Range("D7")
kaplan.Cells(ts, "B") = asi.Range("E7")
kaplan.Cells(ts + 1, "A") = asi.Range("G7")
kaplan.Cells(ts + 1, "B") = asi.Range("H7")
End If
kaplan.Select
kaplan.Range("J1") = Date
End If
End Sub

 

[İhsan Tank]

Sanırım kod işinize yaramadı_?