İlgili hücre boşsa kaydetmesin

[relaxim]

Merhabalar,

A11 den F35 kadar 1 veya 25 satır veri girilebiliyor. Ve bu verileri bir butonla başka sayfaya kaydediyorum.

Sorun şu;
A11 hücresine veri girdik ama b11, c11, d11, e11, f11 hücrelerinden birine veri girmemişsek uyarı verip kaydetmesin.
A12 hücresine veri girdik ama b12, c12 d12, e12, f12 hücrelerinden birine veri girmemişsek uyarı verip kaydetmesin.
A35 ' e kadar

İlgilenenlere şimdiden teşekkürler..

 

[relaxim]

Örnek dosya eklendi.

 

[Ziynettin]

Sub test()
Dim Tbl(), s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("SİP.FORMU")
Set s2 = Sheets("SİPARİŞLER")
son = s1.Range("A" & Rows.Count).End(3).Row
If son < 11 Then MsgBox "İşlem yok..", 16: Exit Sub
say = 0
Tbl = s1.Range("A11:F" & son).Value

For i = 1 To UBound(Tbl)
    If Tbl(i, 1) <> "" Then
        For j = 2 To 6
            If Tbl(i, j) = "" Then say = say + 1
            If say = 1 Then GoTo cik
        Next j
    End If
Next i
cik:

If say = 0 Then
    son2 = s2.Range("A" & Rows.Count).End(3).Row + 1
    s2.Cells(son2, 5).Resize(UBound(Tbl), 6) = Tbl
    MsgBox "Veriler aktrıldı.", 64
Else
    MsgBox "Boş alan mevcut", 48
End If
End Sub

 

[relaxim]

Sub test()
Dim Tbl(), s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("SİP.FORMU")
Set s2 = Sheets("SİPARİŞLER")
son = s1.Range("A" & Rows.Count).End(3).Row
If son < 11 Then MsgBox "İşlem yok..", 16: Exit Sub
say = 0
Tbl = s1.Range("A11:F" & son).Value

For i = 1 To UBound(Tbl)
    If Tbl(i, 1) <> "" Then
        For j = 2 To 6
            If Tbl(i, j) = "" Then say = say + 1
            If say = 1 Then GoTo cik
        Next j
    End If
Next i
cik:

If say = 0 Then
    son2 = s2.Range("A" & Rows.Count).End(3).Row + 1
    s2.Cells(son2, 5).Resize(UBound(Tbl), 6) = Tbl
    MsgBox "Veriler aktrıldı.", 64
Else
    MsgBox "Boş alan mevcut", 48
End If
End Sub

Ziynettin Bey merhaba,

Ancak bakabildim. İlginiz ve çözüm için teşekkürler.

Firma, Sipariş T. ve Sip.No bu üç kolonu da aktarması lazım. Ve aynı sipariş no varsa uyarı vermesi lazım. Örnekte bu şekilde idi. Siz daha farklı yazdığınız için uyarlamaya çalışacağım. Tekrar teşekkürler. Alternatif çözümlere de açığım.

Saygılar....

 

[relaxim]

Merhabalar,

Örneği güncelledim. Modül 23 te nasıl bir düzeltme yapalım ki;

Sorun şu;
A11 hücresine veri girdik ama b11, c11, d11, e11, f11 hücrelerinden birine veri girmemişsek uyarı verip kaydetmesin.
A12 hücresine veri girdik ama b12, c12 d12, e12, f12 hücrelerinden birine veri girmemişsek uyarı verip kaydetmesin.
A35 ' e kadar

İlgilenenlere şimdiden teşekkürler..

 

[relaxim]

Merhabalar,
Sorunumu bu şekilde çözdüm. Emeği geçenlere teşekkürler.

Sub SİPARİŞ()
'If Cells(39, 6) > 4999 Then 'Buradaki değer fatura sayfasındaki kdv li tutar
'If MsgBox("Fatura toplamı 4.999'dan fazla, yinede kaydetmek istiyor musnuz?", vbYesNo) = vbNo Then Exit Sub
'End If
'Sayfa2.PrintPreview
Dim s1 As Worksheet: Set s1 = Sheets("SİP.FORMU")
Dim s2 As Worksheet: Set s2 = Sheets("SİPARİŞLER")
Dim son2 As Long: son2 = s2.Range("A65500").End(xlUp).Row + 1

Dim Tbl()
son = s1.Range("A" & Rows.Count).End(3).Row
If son < 11 Then MsgBox "İşlem yok..", 16: Exit Sub
say1 = 0
Tbl = s1.Range("A11:F" & son).Value
For k = 1 To UBound(Tbl)
If Tbl(k, 1) <> "" Then
For j = 2 To 6
If Tbl(k, j) = "" Then say1 = say1 + 1
If say1 = 1 Then MsgBox "Boş alan mevcut", 48: Exit Sub
Next j
End If
Next k

Say = WorksheetFunction.CountIf(s2.Range("D2" & son2), s1.Cells(3, 5))
If Say > 0 Then MsgBox "Bu sipariş daha önce kaydedilmiştir...", vbInformation, "ASKM": Exit Sub

For i = 11 To 40
If s1.Cells(i, 1) <> "" Then
s2.Cells(son2, 1).Value = son2 - 2 + 1 'SIRA NO
s2.Cells(son2, 2).Value = s1.Cells(2, 1).Value 'firma
s2.Cells(son2, 3).Value = s1.Cells(2, 5).Value 'sip.t
s2.Cells(son2, 4).Value = s1.Cells(3, 5).Value 'sip.no
s2.Cells(son2, 5).Value = s1.Cells(i, 1).Value 'parça no
s2.Cells(son2, 6).Value = s1.Cells(i, 2).Value 'parça adı
s2.Cells(son2, 7).Value = s1.Cells(i, 3).Value 'miktar
s2.Cells(son2, 8).Value = s1.Cells(i, 4).Value 'birim
s2.Cells(son2, 9).Value = s1.Cells(i, 5).Value 'istenen T.
s2.Cells(son2, 10).Value = s1.Cells(i, 6).Value 'Termin T.
s2.Cells(son2, 11).Value = s1.Cells(i, 7).Value 'iş emri no
s2.Cells(son2, 12).Value = s1.Cells(i, 8).Value 'notlar
's2.Cells(son2, 13).Value = Round(s2.Cells(son2, 11) * 0.18, 2)
's2.Cells(son2, 14).Value = s2.Cells(son2, 11) + s2.Cells(son2, 12)
End If
son2 = son2 + 1
Next i


MsgBox "Bu Sipariş kaydedilmiştir.", vbInformation, "soylu": Exit Sub


End Sub