aktar makrosu için yardımınızı bekliyorum

[ex48]

merhaba,
ekteki dosyamda aktar makrosunda düzenleme yapabilirseniz sevinirim, açıklama dosya içinde mevcut.

 

[cetorp2007]

arkadaşım dosyaya baktım ama benim yapabileceğim tarzda değil diğer arkadaşlar umarım yardımcı olurlar

kolay gelsin

 

[N.Ziya Hiçdurmaz]

Yanıt

Sub aktar()
Sheets("Aylık_Kor.Kont").Select
If [K2] = "" Then
MsgBox "Ay adı boş geçilmez.", vbInformation
Exit Sub
End If
For Each SUT In Sheets("İcmal_Kor.Kont").Range("A5:A16")
If [K2] = SUT.Value Then
MsgBox "Bu kayıttan daha önce girilmiş.", vbInformation
If SUT > 2 Then Exit For
End If
Next
If MsgBox("Veriyi aktarmak istiyormusunuz.", vbYesNo) = vbNo Then Exit Sub
For Each SUT In Sheets("İcmal_Kor.Kont").Range("A5:A16")
Range(SUT, SUT.Offset(0, 6)).ClearContents
Next
sat = Sheets("İcmal_Kor.Kont").Cells(65536, "A").End(xlUp).Row + 1
With Sheets("İcmal_Kor.Kont")
    .Cells(sat, "A").Value = Range("K2").Value
    .Cells(sat, "B").Value = Range("D4").Value
    .Cells(sat, "C").Value = Range("G4").Value
    .Cells(sat, "D").Value = Range("H4").Value
    .Cells(sat, "E").Value = Range("I4").Value
    .Cells(sat, "F").Value = Range("J4").Value
    .Cells(sat, "G").Value = Range("K4").Value
End With
Range("K2") = ""
Range("D4") = ""
Range("G4") = ""
Range("H4") = ""
Range("I4") = ""
Range("J4") = ""
Range("K4") = ""
MsgBox "Veriler İcmal_Kor.Kont Sayfasına Aktarıldı..!!", vbOKOnly + vbinf
End Sub

 

[ex48]

Teşekkür ederim, sağolun V.Basic For Applications

 

[ex48]

Merhaba,
3 nolu mesajda ekli dosya için aşağıdaki konularda tekrar yardım istiyorum.

Dosyada yazılı istenen özelliklerden:
b) İkinci kez aktarılmak istenen örneğin "OCAK" Ayı, eğer ilkinde küçük harf kullanılmışsa onay sormuyor. İlkinde yazıldığı gibi yazılmışsa onay soruyor. k2 hücresine ay yazılırken büyük harf girilmesini zorunlu kılamazmıyız.
c) k sütununda toplam formülü vardı, aktarmadan sonra formüllerde siliniyor, formüllü hücreler hariç tutulamazmı,

Ayrıca, Ocak önceden aktarıldı diyelim, Şubatı hemen altına aktarmayıp, Ocak satırına Ocak verilerini silip aktarıyor.

 

[ex48]

excel üstadı arkadaşlar, lütfen yardım ediniz.

 

[Orion1]

Ekli dosyayı inceleyiniz.

 

[ex48]

Ekli dosyayı inceleyiniz.

Öncelikle teşekkür ederim
örneğin şubatı 2.kez aktardığımızda, icmalde 1. aktarılan şubat verilerini silip aynı satıra yenisini yazdırabilirmiyiz.
Cetvelden aktardığı verileri silerken formüllü hücreleri hariç tutabilirmiyiz.

 

[ex48]

Merhaba
Formüllerin silinmemesini hallettim,
Aktarmada örneğin şubatı 2.kez aktarıyorsak, icmalde 1. aktarılan şubat verilerini silip aynı satıra yenisini yazdırabilirmiyiz.

 

[Orion1]

Merhaba
Formüllerin silinmemesini hallettim,
Aktarmada örneğin şubatı 2.kez aktarıyorsak, icmalde 1. aktarılan şubat verilerini silip aynı satıra yenisini yazdırabilirmiyiz.

Ekli dosyayı inceleyiniz.Kırmızı satırları ilave ettim.

Sub aktar()
Sheets("Aylık_Kor.Kont").Select
If [K2] = "" Then
MsgBox "Ay adı boş geçilmez.", vbInformation
Exit Sub
End If
For Each SUT In Sheets("İcmal_Kor.Kont").Range("A5:A16")
If [K2] = SUT.Value Then
MsgBox "Bu kayıttan daha önce girilmiş.", vbInformation
If SUT > 2 Then Exit For
End If
Next
If MsgBox("Veriyi aktarmak istiyormusunuz.", vbYesNo) = vbNo Then Exit Sub
[B][COLOR="Red"]Set k = Sheets("İcmal_Kor.Kont").Range("A5:A65536").Find(Range("K2").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
With Sheets("İcmal_Kor.Kont")
    .Cells(k.Row, "A").Value = Range("K2").Value
    .Cells(k.Row, "B").Value = Range("D4").Value
    .Cells(k.Row, "C").Value = Range("G4").Value
    .Cells(k.Row, "D").Value = Range("H4").Value
    .Cells(k.Row, "E").Value = Range("I4").Value
    .Cells(k.Row, "F").Value = Range("J4").Value
    .Cells(k.Row, "G").Value = Range("K4").Value
End With
Else[/COLOR][/B]
sat = Sheets("İcmal_Kor.Kont").Cells(65536, "A").End(xlUp).Row + 1
With Sheets("İcmal_Kor.Kont")
    .Cells(sat, "A").Value = Range("K2").Value
    .Cells(sat, "B").Value = Range("D4").Value
    .Cells(sat, "C").Value = Range("G4").Value
    .Cells(sat, "D").Value = Range("H4").Value
    .Cells(sat, "E").Value = Range("I4").Value
    .Cells(sat, "F").Value = Range("J4").Value
    .Cells(sat, "G").Value = Range("K4").Value
End With
[COLOR="red"][B]End If[/B][/COLOR]
Range("K2") = ""
Range("D4") = ""
Range("G4") = ""
Range("H4") = ""
Range("I4") = ""
Range("J4") = ""
Range("K4") = ""
MsgBox "Veriler İcmal_Kor.Kont Sayfasına Aktarıldı..!!", vbOKOnly + vbinf
End Sub

 

[ex48]

Çok teşekkür ederim Orion2, sayenizde istediğim gibi oldu.
Hayırlı Günler.

 

[Orion1]

Çok teşekkür ederim Orion2, sayenizde istediğim gibi oldu.
Hayırlı Günler.

Rica ederim.
İyi çalışmalar.