• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Veri gönderirken Aynı tarih varsa İkaz versin

E

excellkurdu

Katılım
16 Nisan 2008
Mesajlar
313
Excel Vers. ve Dili
Türkçe Microsoft Office Excel 2007
Selam Arkadaşlar,
ServisFORM sayfasından Y4 deki tarihe göre veri gönderirken, Dataservis sayfasındaki C sütününda aynı tarih varsa "Aynı tarih var yine de kaydetmek istiyormusun" ikazını versin kodunu nasıl ekleyebiliriz?
Saygılarımla.
Kod: 
Sub aktar()
Set s10 = ThisWorkbook.Worksheets("ServisFORM")
Set s11 = ThisWorkbook.Worksheets("Dataservis")
If s10.Cells(4, 25) = "" Then End
sonsatir = s11.Range("A65536").End(xlUp).Row + 1

s11.Cells(sonsatir, 1) = s10.Cells(4, 5)
s11.Cells(sonsatir, 2) = s10.Cells(5, 5)
s11.Cells(sonsatir, 3) = s10.Cells(4, 25)
s11.Cells(sonsatir, 4) = s10.Cells(5, 22)
s11.Cells(sonsatir, 5) = s10.Cells(5, 27)
s11.Cells(sonsatir, 6) = s10.Cells(9, 2)
s11.Cells(sonsatir, 7) = s10.Cells(9, 6)
s11.Cells(sonsatir, 8) = s10.Cells(9, 9)
s11.Cells(sonsatir, 9) = s10.Cells(9, 13)
s11.Cells(sonsatir, 10) = s10.Cells(9, 16)
s11.Cells(sonsatir, 11) = s10.Cells(9, 20)
s11.Cells(sonsatir, 12) = s10.Cells(9, 24)
s11.Cells(sonsatir, 13) = s10.Cells(9, 27)

s11.Cells(sonsatir, 14) = s10.Cells(11, 13)
s11.Cells(sonsatir, 15) = s10.Cells(12, 13)
s11.Cells(sonsatir, 16) = s10.Cells(13, 13)
s11.Cells(sonsatir, 17) = s10.Cells(14, 13)
s11.Cells(sonsatir, 18) = s10.Cells(15, 13)
s11.Cells(sonsatir, 19) = s10.Cells(16, 13)
s11.Cells(sonsatir, 20) = s10.Cells(17, 13)

s11.Cells(sonsatir, 21) = s10.Cells(11, 18)
s11.Cells(sonsatir, 22) = s10.Cells(12, 18)
s11.Cells(sonsatir, 23) = s10.Cells(13, 18)
s11.Cells(sonsatir, 24) = s10.Cells(14, 18)
s11.Cells(sonsatir, 25) = s10.Cells(15, 18)
s11.Cells(sonsatir, 26) = s10.Cells(16, 18)
s11.Cells(sonsatir, 27) = s10.Cells(17, 18)
s11.Cells(sonsatir, 28) = s10.Cells(18, 18)
s11.Cells(sonsatir, 29) = s10.Cells(19, 18)
s11.Cells(sonsatir, 30) = s10.Cells(20, 18)

s11.Cells(sonsatir, 31) = s10.Cells(23, 2)
s11.Cells(sonsatir, 32) = s10.Cells(24, 2)
s11.Cells(sonsatir, 33) = s10.Cells(25, 2)
s11.Cells(sonsatir, 34) = s10.Cells(26, 2)
s11.Cells(sonsatir, 35) = s10.Cells(27, 2)
s11.Cells(sonsatir, 36) = s10.Cells(28, 2)
s11.Cells(sonsatir, 37) = s10.Cells(29, 2)
s11.Cells(sonsatir, 38) = s10.Cells(30, 2)
s11.Cells(sonsatir, 39) = s10.Cells(31, 2)
s11.Cells(sonsatir, 40) = s10.Cells(32, 2)

s11.Cells(sonsatir, 41) = s10.Cells(23, 10)
s11.Cells(sonsatir, 42) = s10.Cells(24, 10)
s11.Cells(sonsatir, 43) = s10.Cells(25, 10)
s11.Cells(sonsatir, 44) = s10.Cells(26, 10)
s11.Cells(sonsatir, 45) = s10.Cells(27, 10)
s11.Cells(sonsatir, 46) = s10.Cells(28, 10)
s11.Cells(sonsatir, 47) = s10.Cells(29, 10)
s11.Cells(sonsatir, 48) = s10.Cells(30, 10)
s11.Cells(sonsatir, 49) = s10.Cells(31, 10)
s11.Cells(sonsatir, 50) = s10.Cells(32, 10)

s11.Cells(sonsatir, 51) = s10.Cells(23, 19)
s11.Cells(sonsatir, 52) = s10.Cells(24, 19)
s11.Cells(sonsatir, 53) = s10.Cells(25, 19)
s11.Cells(sonsatir, 54) = s10.Cells(26, 19)
s11.Cells(sonsatir, 55) = s10.Cells(27, 19)
s11.Cells(sonsatir, 56) = s10.Cells(28, 19)
s11.Cells(sonsatir, 57) = s10.Cells(29, 19)
s11.Cells(sonsatir, 58) = s10.Cells(30, 19)
s11.Cells(sonsatir, 59) = s10.Cells(31, 19)
s11.Cells(sonsatir, 60) = s10.Cells(32, 19)

s11.Cells(sonsatir, 61) = s10.Cells(35, 12)
s11.Cells(sonsatir, 62) = s10.Cells(38, 8)
s11.Cells(sonsatir, 63) = s10.Cells(42, 1)
s11.Cells(sonsatir, 64) = s10.Cells(42, 16)

Set s11 = Nothing
MsgBox "Veri Saklama Gönderimi Tamamlandı! Lütfen Dosyayı Kaydediniz...", vbInformation
End Sub
 

Ekli dosyalar

şu kodu yaz işin görülür
Kod: 
Sub aktar()

Set s10 = ThisWorkbook.Worksheets("ServisFORM")
Set s11 = ThisWorkbook.Worksheets("Dataservis")
i = s11.Range("A65536").End(xlUp).Row + 1
sonsatir = s11.Range("A65536").End(xlUp).Row + 1
Dim x As Integer
Dim mesaj
For x = 4 To i
If s10.Cells(4, 25) = s11.Cells(x, 3) Then
mesaj = MsgBox(s10.Cells(4, 25) & " Tarihli kayıt zaten var Yinede kayıt etmek istermisiniz ?", vbYesNo + vbQuestion, "Kayıt Bilgisi")
If mesaj = vbYes Then
If s10.Cells(4, 25) = "" Then End
s11.Cells(sonsatir, 1) = s10.Cells(4, 5)
s11.Cells(sonsatir, 2) = s10.Cells(5, 5)
s11.Cells(sonsatir, 3) = s10.Cells(4, 25)
s11.Cells(sonsatir, 4) = s10.Cells(5, 22)
s11.Cells(sonsatir, 5) = s10.Cells(5, 27)
s11.Cells(sonsatir, 6) = s10.Cells(9, 2)
s11.Cells(sonsatir, 7) = s10.Cells(9, 6)
s11.Cells(sonsatir, 8) = s10.Cells(9, 9)
s11.Cells(sonsatir, 9) = s10.Cells(9, 13)
s11.Cells(sonsatir, 10) = s10.Cells(9, 16)
s11.Cells(sonsatir, 11) = s10.Cells(9, 20)
s11.Cells(sonsatir, 12) = s10.Cells(9, 24)
s11.Cells(sonsatir, 13) = s10.Cells(9, 27)

s11.Cells(sonsatir, 14) = s10.Cells(11, 13)
s11.Cells(sonsatir, 15) = s10.Cells(12, 13)
s11.Cells(sonsatir, 16) = s10.Cells(13, 13)
s11.Cells(sonsatir, 17) = s10.Cells(14, 13)
s11.Cells(sonsatir, 18) = s10.Cells(15, 13)
s11.Cells(sonsatir, 19) = s10.Cells(16, 13)
s11.Cells(sonsatir, 20) = s10.Cells(17, 13)

s11.Cells(sonsatir, 21) = s10.Cells(11, 18)
s11.Cells(sonsatir, 22) = s10.Cells(12, 18)
s11.Cells(sonsatir, 23) = s10.Cells(13, 18)
s11.Cells(sonsatir, 24) = s10.Cells(14, 18)
s11.Cells(sonsatir, 25) = s10.Cells(15, 18)
s11.Cells(sonsatir, 26) = s10.Cells(16, 18)
s11.Cells(sonsatir, 27) = s10.Cells(17, 18)
s11.Cells(sonsatir, 28) = s10.Cells(18, 18)
s11.Cells(sonsatir, 29) = s10.Cells(19, 18)
s11.Cells(sonsatir, 30) = s10.Cells(20, 18)

s11.Cells(sonsatir, 31) = s10.Cells(23, 2)
s11.Cells(sonsatir, 32) = s10.Cells(24, 2)
s11.Cells(sonsatir, 33) = s10.Cells(25, 2)
s11.Cells(sonsatir, 34) = s10.Cells(26, 2)
s11.Cells(sonsatir, 35) = s10.Cells(27, 2)
s11.Cells(sonsatir, 36) = s10.Cells(28, 2)
s11.Cells(sonsatir, 37) = s10.Cells(29, 2)
s11.Cells(sonsatir, 38) = s10.Cells(30, 2)
s11.Cells(sonsatir, 39) = s10.Cells(31, 2)
s11.Cells(sonsatir, 40) = s10.Cells(32, 2)

s11.Cells(sonsatir, 41) = s10.Cells(23, 10)
s11.Cells(sonsatir, 42) = s10.Cells(24, 10)
s11.Cells(sonsatir, 43) = s10.Cells(25, 10)
s11.Cells(sonsatir, 44) = s10.Cells(26, 10)
s11.Cells(sonsatir, 45) = s10.Cells(27, 10)
s11.Cells(sonsatir, 46) = s10.Cells(28, 10)
s11.Cells(sonsatir, 47) = s10.Cells(29, 10)
s11.Cells(sonsatir, 48) = s10.Cells(30, 10)
s11.Cells(sonsatir, 49) = s10.Cells(31, 10)
s11.Cells(sonsatir, 50) = s10.Cells(32, 10)

s11.Cells(sonsatir, 51) = s10.Cells(23, 19)
s11.Cells(sonsatir, 52) = s10.Cells(24, 19)
s11.Cells(sonsatir, 53) = s10.Cells(25, 19)
s11.Cells(sonsatir, 54) = s10.Cells(26, 19)
s11.Cells(sonsatir, 55) = s10.Cells(27, 19)
s11.Cells(sonsatir, 56) = s10.Cells(28, 19)
s11.Cells(sonsatir, 57) = s10.Cells(29, 19)
s11.Cells(sonsatir, 58) = s10.Cells(30, 19)
s11.Cells(sonsatir, 59) = s10.Cells(31, 19)
s11.Cells(sonsatir, 60) = s10.Cells(32, 19)

s11.Cells(sonsatir, 61) = s10.Cells(35, 12)
s11.Cells(sonsatir, 62) = s10.Cells(38, 8)
s11.Cells(sonsatir, 63) = s10.Cells(42, 1)
s11.Cells(sonsatir, 64) = s10.Cells(42, 16)
Set s11 = Nothing
MsgBox "Veri Saklama Gönderimi Tamamlandı! Lütfen Dosyayı Kaydediniz...", vbInformation
End If
End If
Next x
End Sub
 
Hocam şu hatayı verdi.
Run-time error '91'
object variable or with block variable not set
güvenlik ayarlarına baktım veri dışı hücreler korumalı veri akışı hücreler korumasız. Bundan olabilir mi?
 
Hocam tüm kilitleri açtım, tüm engellere izin verdim ama hata devam etti. Aynı zamanda Y4 e farklı tarih girince macro çalışmadı.
 
Sorunua bakım sana haber edim
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst