DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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
Öncelikle teşekkür ederimEkli dosyayı inceleyiniz.![]()
Ekli dosyayı inceleyiniz.Kırmızı satırları ilave ettim.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.
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
Rica ederim.Çok teşekkür ederim Orion2, sayenizde istediğim gibi oldu.
Hayırlı Günler.