şartlı veri aktarma

[ormann]

Ekteki örnek dosyamda veri aktar butonuna bastığımda veriler diğer sayfaya aktarılıyor.Benim istediğim "D6" hücresinde veri varsa aktarma gerekleşsin.Eğer D6 hücresinde veri yok ise "Kayıt olmadığından aktarma işlemi gerçekleşmedi " diye uyarı vermesini nasıl sağlayabiliriz.Yardımcı olurmusunuz

 

[N.Ziya Hiçdurmaz]

yanıt

Kodun başına ekleyiniz.

If [d6] = "" Then
MsgBox ("Önce veri girmelisiniz."), vbInformation
Exit Sub
End If

 

[ormann]

Sayın Niyazi çok teşekkür ederim.

 

[ormann]

Sayın arkadaşlar aşağıdaki makroda sadece d6 hücresinde veri yoksa aktarma işlemi yapmıyo.Bu makroya d10 hücresinide ekleyebilirmiyiz.Yani bu iki hücrede dolu olursa aktarma yapsın biri dolu biri boş ise aktarma yapmasın.Yardımcı olurmusunuz ?

If [d6] = "" Then
MsgBox ("Önce veri girmelisiniz."), vbInformation
Exit Sub
End If

 

[Excelmy]

Sayın arkadaşlar aşağıdaki makroda sadece d6 hücresinde veri yoksa aktarma işlemi yapmıyo.Bu makroya d10 hücresinide ekleyebilirmiyiz.Yani bu iki hücrede dolu olursa aktarma yapsın biri dolu biri boş ise aktarma yapmasın.Yardımcı olurmusunuz ?

If [d6] = "" Then
MsgBox ("Önce veri girmelisiniz."), vbInformation
Exit Sub
End If

Bu şekilde ;

If Sheets("anasayfa").Range("D6") = "" Then
MsgBox ("Adı Belirtilmemiş."), vbCritical, " HATA"
Exit Sub
End If
If Sheets("anasayfa").Range("D10") = "" Then
MsgBox ("No Belirtilmemiş."), vbCritical, " HATA"
Exit Sub
End If

veya ;

If Sheets("anasayfa").Range("D6") = "" Or  Sheets("anasayfa").Range("D10") = "" Then
MsgBox ("Önce veri girmelisiniz."), vbCritical, " HATA"
Exit Sub
End If

 

[ormann]

Sayın Kuman Bu kodu aşağıdaki makroda nasıl uygulayabilirim

Sub orman()

If [d6] = "" Then
MsgBox ("Önce veri girmelisiniz."), vbInformation
Exit Sub
End If
Sheets("SUÇBİLGİLERİGİRİŞİ").Unprotect 1978

Dim s, Dosya_Yolu As String
Dosya_Yolu = ThisWorkbook.Path & "\"
Dim yer As Worksheet
Dim bul As Range
Dim sat As Integer
ExecuteExcel4Macro ("SOUND.PLAY(, """ & Dosya_Yolu & "VERİLERİNİZ AKTARILSINMI.wav"")")
If MsgBox("VERİLERİNİZ AKTARILSIN MI ?", vbExclamation + vbYesNo, "Alidogan5557@hotmail.com") = vbYes Then
Set yer = Sheets("SUÇ KAYDI")
Set bul = yer.Range("A:A").Find(Range("D5"), , xlValues, xlWhole)
If Not bul Is Nothing Then
sat = bul.Row
Else
sat = yer.Range("A65536").End(xlUp).Row + 1
End If
Range("D542").Copy
yer.Range("A" & sat).PasteSpecial xlPasteValues, , , True
Range("D542,C3,D3,E3,F3,G3,H3").ClearContents
Application.CutCopyMode = False
ExecuteExcel4Macro ("SOUND.PLAY(, """ & Dosya_Yolu & "VERİLERİNİZ AKTARILDI.wav"")")

Else
ExecuteExcel4Macro ("SOUND.PLAY(, """ & Dosya_Yolu & "AKTARMA İŞLEMİ İPTAL EDİLDİ.wav"")")
End If

Range("D5").Activate
Sheets("SUÇBİLGİLERİGİRİŞİ").Protect 1978
End Sub

 

[Excelmy]

[COLOR="Red"]Dim sat As Integer[/COLOR]
.....
.......
........
[COLOR="red"]ExecuteExcel4Macro ("SOUND.PLAY(, """ & Dosya_Yolu & "VERİLERİNİZ AKTARILSINMI.wav"")")[/COLOR]

Kırmızı renkli satırları bulun, yukarıda .... ile belirttiğim gibi ortasına ekleyin.

 

[ormann]

Sayın Kuman çok teşekkür ederim