Boş hücre olunca kayıt yapmasın?

[ugurabi]

Alttaki kod ile Sayfa1 de B3:H3 satırına yazılanları Sayfa2'ye kaydediyorum.
Ancak boş hücre olunca da kayıt yapıyor.
Oysa ben tüm hücreler dolu olunca kayıt yapsın istiyorum.

Bu nedenle de;

Msgbox ("Tüm alanları doldurun") şeklinde bir mesaj kutusu açılmasını nasıl yapmalıyım?

Sub Kaydet()
Yeni = Sheets("Sayfa2").Cells(Rows.Count, "b").End(3).Row + 1
[B3:H3].Copy Sheets("Sayfa2").Cells(Yeni, "b")  
End Sub

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Sub Kaydet()
    Yeni = Sheets("Sayfa2").Cells(Rows.Count, "b").End(3).Row + 1
If WorksheetFunction.CountBlank([B3:H3]) > 0 Then
    MsgBox "Lütfen tüm alanları doldurun!"
    Set c = [B3:H3].Find("")
    If Not c Is Nothing Then c.Select
    GoTo 10
End If
[B3:H3].Copy Sheets("Sayfa2").Cells(Yeni, "b")
[B3].Select
10:
End Sub

 

[ugurabi]

Aşağıdaki gibi deneyin:

Sub Kaydet()
    Yeni = Sheets("Sayfa2").Cells(Rows.Count, "b").End(3).Row + 1
If WorksheetFunction.CountBlank([B3:H3]) > 0 Then
    MsgBox "Lütfen tüm alanları doldurun!"
    Set c = [B3:H3].Find("")
    If Not c Is Nothing Then c.Select
    GoTo 10
End If
[B3:H3].Copy Sheets("Sayfa2").Cells(Yeni, "b")
[B3].Select
10:
End Sub

Teşekkürler, sorunsuz çalışıyor.