• DİKKAT

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

Hücre değerine göre veri kaydetme

K

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,677
Excel Vers. ve Dili
Excel 2010 32 bit
Merhaba
Aşağıdaki kod ile "O" sutunundaki hücre değeri "DÖŞEMELİ GRUPLAR" ise
o satırın "DÖŞEMELİ GRUPLAR" Sahifesine kaydetmesini istiyorum.Diğerlerinin kayıt yapmamasını istiyorum.
İf komutu ile aşağıdaki şartı oluşturarak yapmaya çalıştım.
Next Z satırı hata veriyor.
Bu koşullu kayıtı nasıl yapabilirim.
Teşekkür ederim.
Kod: 
Set S3 = Sheets("DOSEME")
For Z = 8 To s1.Range("O655536").End(3).Row
SONSTR1 = S3.Range("A65536").End(3).Row + 1
If Z = "DÖŞEMELİ GRUPLAR" Then

S3.Cells(SONSTR1, 1).Value = WorksheetFunction.Max(S3.[A2:A50000]) + 1
S3.Cells(SONSTR1, 2).Value = Date
S3.Cells(SONSTR1, 3).Value = "YENİ SİPARİŞ"
S3.Cells(SONSTR1, 7).Value = s1.Cells(Z, 19).Value & " " & S3.Range("A65536").End(3).Row
S3.Cells(SONSTR1, 8).Value = s1.Cells(Z, 2).Value
S3.Cells(SONSTR1, 9).Value = s1.Cells(Z, 3).Value
[B]Next Z[/B]
Else
Exit Sub
End If
 
For next döngüsünde Z değişkenine 8'den son dolu satır numarasına kadar değer verdiriyorsunuz. Ancak if satırında Z'nin "DÖŞEMELİ GRUPLAR" olup olmadığını sorguluyorsunuz. Bu garip değil mi? Yani Z ya 8 olur ya 9 ya 15 ya 300 vs . Sayısal bir değer olur, DÖŞEMELİ GRUPLAR olmaz.

Sorununuzu çözer mi bilmiyorum ancak doğru satır şöyle olmalı:

Kod: 
if cells(Z,"O") = "DÖŞEMELİ GRUPLAR" then

Eğer sorun çözülmezse örnek dosya ekleyin ki deneyerek çözebilelim.
 
Merhaba Yusuf Hocam,
Aynı hatayı verdi.Ek dosya oluşturdum çözüm için size yardımcı olabilecek.
Kaydet Butonu ile yapmak istediğim,
Bütün satırları "TÜM SİPARİŞLER" adlı sahifeye kaydetmesi
for i döngüsü ile bunu yapabiliyoruz.
Ayrıca
O sutunundaki hücre değeri "DÖŞEMELİ GRUPLAR" ise "DOSEME" Sahifesine
O sutunundaki hücre değeri "MODÜLER" ise "MODÜLER" Sahifesine
O sutunundaki hücre değeri "SANDALYE" ise "SANDALYE" Sahifesine
Kayıt yapmasını istiyorum.
Teşekkür ederim.
 

Ekli dosyalar

O hata For-Next ve/veya if/End if döngülerinden birinin kapatılmaması ya da eksik kalmasıyla ilgili.

Bu hataya düşmemek için tavsiye ederim ki her for next ve if end if bloğunun arasındaki satırları bir "TAB" içeri kademeli olarak yazın.

sizin kodlarınızda son bölümde önce For satırı, sonra if satırı, sonra yapılacak işlemler, sonra Next satırı sonra da Else ve end if var. Halbuki kapatma işleminin açılışın tersi olması gerekiyor, yani son açılan ilk kapatılmalı. For - İf - yapılacaklar - End if - Next şeklinde.

Ayrıca kodlarınızda if sorgusunda gereksiz yere Else kullanıyorsunuz. Else kullanımı "değilse şunu yap" anlamındadır. Eğer başka bir şey yapmayacaksa zaten End if ile blok sonlanacaktır. Else'ten sonra başka işlem(ler) yaptırmayacaksanız Else'e gerek yok.

Bu açıklamalarıma göre kodunuzun son şekli şöyle oluyor:

Kod: 
Sub Dikdörtgen6_Tıklat()
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("TUMSIPARISLER")

Application.ScreenUpdating = False
'For Each ayni In Sheets("TUMSIPARISLER").Range("Z2:Z10000")
'   If ayni.Value = Range("F2").Value Then
'       DUR4 = MsgBox("KAYIT YAPTIĞINIZ SİPARİŞ NO DAHA ÖNCE KAYIT YAPILMIŞ.", vbYes, "MÜKERRER KAYIT")
'       Exit Sub
'   End If
'Next

If s1.Range("C2").Value = "" Then
    MsgBox "Sipariş Tarihini Giriniz."
    Exit Sub
End If

If s1.Range("F2").Value = "" Then
    MsgBox "Tiger Sip.No. Giriniz."
    Exit Sub
End If

If s1.Range("C3").Value = "" Then
    MsgBox "Cari seçiniz"
    Exit Sub
End If

If s1.Range("B8").Value = "" Then
    MsgBox "Ürün seçmediniz."
    Exit Sub
End If

m = MsgBox("KAYIT YAPILSIN MI.", vbYesNo, "Hevin / Planlama")
If m <> vbYes Then Exit Sub

Worksheets("TUMSIPARISLER").AutoFilterMode = False

For i = 8 To s1.Range("c655536").End(3).Row
    SONSTR = s2.Range("A65536").End(3).Row + 1
    s2.Cells(SONSTR, 1).Value = WorksheetFunction.Max(s2.[A2:A50000]) + 1
    s2.Cells(SONSTR, 2).Value = Date
    s2.Cells(SONSTR, 3).Value = "YENİ SİPARİŞ"
    s2.Cells(SONSTR, 7).Value = s1.Cells(i, 19).Value & " " & s2.Range("A65536").End(3).Row
    s2.Cells(SONSTR, 8).Value = s1.Cells(i, 2).Value
    s2.Cells(SONSTR, 9).Value = s1.Cells(i, 3).Value
    s2.Cells(SONSTR, 10).Value = s1.Cells(i, 7).Value
    s2.Cells(SONSTR, 11).Value = s1.Cells(i, 8).Value
    s2.Cells(SONSTR, 12).Value = s1.Cells(i, 9).Value
    s2.Cells(SONSTR, 13).Value = s1.Cells(i, 10).Value
    s2.Cells(SONSTR, 14).Value = s1.Cells(i, 11).Value
    s2.Cells(SONSTR, 15).Value = s1.Cells(i, 12).Value
    s2.Cells(SONSTR, 16).Value = s1.Cells(i, 13).Value
    s2.Cells(SONSTR, 17).Value = s1.Cells(i, 14).Value
    s2.Cells(SONSTR, 18).Value = s1.Range("C3").Value
    s2.Cells(SONSTR, 19).Value = s1.Range("C5").Value
    s2.Cells(SONSTR, 20).Value = s1.Range("C4").Value
    s2.Cells(SONSTR, 21).Value = s1.Cells(i, 15).Value
    s2.Cells(SONSTR, 22).Value = s1.Cells(i, 16).Value
    s2.Cells(SONSTR, 23).Value = s1.Cells(i, 17).Value
    s2.Cells(SONSTR, 24).Value = s1.Cells(i, 18).Value
    s2.Cells(SONSTR, 25).Value = s1.Cells(i, 19).Value
    s2.Cells(SONSTR, 26).Value = s1.Range("F2").Value
Next i

Set S3 = Sheets("DOSEME")

For Z = 8 To s1.Range("O655536").End(3).Row
    SONSTR1 = S3.Range("A65536").End(3).Row + 1
    If Cells(Z, "O") = "DÖŞEMELİ GRUPLAR" Then
        S3.Cells(SONSTR1, 1).Value = WorksheetFunction.Max(S3.[A2:A50000]) + 1
        S3.Cells(SONSTR1, 2).Value = Date
        S3.Cells(SONSTR1, 3).Value = "YENİ SİPARİŞ"
        S3.Cells(SONSTR1, 7).Value = s1.Cells(Z, 19).Value & " " & S3.Range("A65536").End(3).Row
        S3.Cells(SONSTR1, 8).Value = s1.Cells(Z, 2).Value
        S3.Cells(SONSTR1, 9).Value = s1.Cells(Z, 3).Value
        S3.Cells(SONSTR1, 10).Value = s1.Cells(Z, 7).Value
        S3.Cells(SONSTR1, 11).Value = s1.Cells(Z, 8).Value
        S3.Cells(SONSTR1, 12).Value = s1.Cells(Z, 9).Value
        S3.Cells(SONSTR1, 13).Value = s1.Cells(Z, 10).Value
        S3.Cells(SONSTR1, 14).Value = s1.Cells(Z, 11).Value
        S3.Cells(SONSTR1, 15).Value = s1.Cells(Z, 12).Value
        S3.Cells(SONSTR1, 16).Value = s1.Cells(Z, 13).Value
        S3.Cells(SONSTR1, 17).Value = s1.Cells(Z, 14).Value
        S3.Cells(SONSTR1, 18).Value = s1.Range("C3").Value
        S3.Cells(SONSTR1, 19).Value = s1.Range("C5").Value
        S3.Cells(SONSTR1, 20).Value = s1.Range("C4").Value
        S3.Cells(SONSTR1, 21).Value = s1.Cells(Z, 15).Value
        S3.Cells(SONSTR1, 22).Value = s1.Cells(Z, 16).Value
        S3.Cells(SONSTR1, 23).Value = s1.Cells(Z, 17).Value
        S3.Cells(SONSTR1, 24).Value = s1.Cells(Z, 18).Value
        S3.Cells(SONSTR1, 25).Value = s1.Cells(Z, 19).Value
        S3.Cells(SONSTR1, 26).Value = s1.Range("F2").Value
    End If
Next Z

Application.ScreenUpdating = True

MsgBox "Kayıt işlemi tamamlanmıştır.", , "excel web tr"

End Sub
 
İlgili sayfaya kayıt için ise kodu aşağıdaki gibi kullanın. Ancak bu kodun düzgün çalışması için O sütunundaki sayfa adlarıyla dosyadaki sayfa adlarının aynı olması gerekir. Örneğin DOSEME olan sayfa adını ana sayfada kullandığınız gibi DÖŞEMELİ GRUPLAR olarak değiştirmelisiniz. Eğer sayfa bulunamazsa hata mesajı verecek ve makroyu sonlandıracaktır. Bu da kayıtlarınızın düzenini bozar:

Kod: 
Sub Dikdörtgen6_Tıklat()
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("TUMSIPARISLER")

Application.ScreenUpdating = False
'For Each ayni In Sheets("TUMSIPARISLER").Range("Z2:Z10000")
'   If ayni.Value = Range("F2").Value Then
'       DUR4 = MsgBox("KAYIT YAPTIĞINIZ SİPARİŞ NO DAHA ÖNCE KAYIT YAPILMIŞ.", vbYes, "MÜKERRER KAYIT")
'       Exit Sub
'   End If
'Next

If s1.Range("C2").Value = "" Then
    MsgBox "Sipariş Tarihini Giriniz."
    Exit Sub
End If

If s1.Range("F2").Value = "" Then
    MsgBox "Tiger Sip.No. Giriniz."
    Exit Sub
End If

If s1.Range("C3").Value = "" Then
    MsgBox "Cari seçiniz"
    Exit Sub
End If

If s1.Range("B8").Value = "" Then
    MsgBox "Ürün seçmediniz."
    Exit Sub
End If

m = MsgBox("KAYIT YAPILSIN MI.", vbYesNo, "Hevin / Planlama")
If m <> vbYes Then Exit Sub

Worksheets("TUMSIPARISLER").AutoFilterMode = False

For i = 8 To s1.Range("c655536").End(3).Row
    SONSTR = s2.Range("A65536").End(3).Row + 1
    s2.Cells(SONSTR, 1).Value = WorksheetFunction.Max(s2.[A2:A50000]) + 1
    s2.Cells(SONSTR, 2).Value = Date
    s2.Cells(SONSTR, 3).Value = "YENİ SİPARİŞ"
    s2.Cells(SONSTR, 7).Value = s1.Cells(i, 19).Value & " " & s2.Range("A65536").End(3).Row
    s2.Cells(SONSTR, 8).Value = s1.Cells(i, 2).Value
    s2.Cells(SONSTR, 9).Value = s1.Cells(i, 3).Value
    s2.Cells(SONSTR, 10).Value = s1.Cells(i, 7).Value
    s2.Cells(SONSTR, 11).Value = s1.Cells(i, 8).Value
    s2.Cells(SONSTR, 12).Value = s1.Cells(i, 9).Value
    s2.Cells(SONSTR, 13).Value = s1.Cells(i, 10).Value
    s2.Cells(SONSTR, 14).Value = s1.Cells(i, 11).Value
    s2.Cells(SONSTR, 15).Value = s1.Cells(i, 12).Value
    s2.Cells(SONSTR, 16).Value = s1.Cells(i, 13).Value
    s2.Cells(SONSTR, 17).Value = s1.Cells(i, 14).Value
    s2.Cells(SONSTR, 18).Value = s1.Range("C3").Value
    s2.Cells(SONSTR, 19).Value = s1.Range("C5").Value
    s2.Cells(SONSTR, 20).Value = s1.Range("C4").Value
    s2.Cells(SONSTR, 21).Value = s1.Cells(i, 15).Value
    s2.Cells(SONSTR, 22).Value = s1.Cells(i, 16).Value
    s2.Cells(SONSTR, 23).Value = s1.Cells(i, 17).Value
    s2.Cells(SONSTR, 24).Value = s1.Cells(i, 18).Value
    s2.Cells(SONSTR, 25).Value = s1.Cells(i, 19).Value
    s2.Cells(SONSTR, 26).Value = s1.Range("F2").Value
Next i


For Z = 8 To s1.Range("O655536").End(3).Row
    On Error GoTo 10
    SONSTR1 = Sheets(Cells(Z, "O").Value).Range("A65536").End(3).Row + 1
    If Cells(Z, "O") = "DÖŞEMELİ GRUPLAR" Then
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 1).Value = WorksheetFunction.Max(Sheets(Cells(Z, "O").Value).[A2:A50000]) + 1
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 2).Value = Date
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 3).Value = "YENİ SİPARİŞ"
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 7).Value = s1.Cells(Z, 19).Value & " " & Sheets(Cells(Z, "O").Value).Range("A65536").End(3).Row
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 8).Value = s1.Cells(Z, 2).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 9).Value = s1.Cells(Z, 3).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 10).Value = s1.Cells(Z, 7).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 11).Value = s1.Cells(Z, 8).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 12).Value = s1.Cells(Z, 9).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 13).Value = s1.Cells(Z, 10).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 14).Value = s1.Cells(Z, 11).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 15).Value = s1.Cells(Z, 12).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 16).Value = s1.Cells(Z, 13).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 17).Value = s1.Cells(Z, 14).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 18).Value = s1.Range("C3").Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 19).Value = s1.Range("C5").Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 20).Value = s1.Range("C4").Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 21).Value = s1.Cells(Z, 15).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 22).Value = s1.Cells(Z, 16).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 23).Value = s1.Cells(Z, 17).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 24).Value = s1.Cells(Z, 18).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 25).Value = s1.Cells(Z, 19).Value
        Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 26).Value = s1.Range("F2").Value
    End If
Next Z

MsgBox "Kayıt işlemi tamamlanmıştır.", , "excel web tr"
10:
MsgBox Cells(Z, "O") & " adlı sayfa bulunamadı!", vbCritical

Application.ScreenUpdating = True

End Sub
 
Merhaba Yusuf Hocam,
Çok teşekkür ederim.
Açıklamalarınız için ayrıca teşekkür ederim.
Haklısınız ben forumdaki kodlardan alıntı ve revize ile deneme yanılma yaparak bir şeyler yapmaya anlamaya çalışan bir kulvarda yürüyorum.
Bu kodlamaları temelden başlayıp öğrenme imkanım olsa dediğiniz hususlar olmayacak.
İnşaallah o düzeye geliriz bir gün.
Hakkınızı helal ediniz.
Selametle
 
Merhaba Yusuf hocam,
Kod DÖŞEMELİ GRUPLAR Sahifesi dışındaki hücre değerlerinde "x adlı sayfa bulunamadı" hatası veriyordu. Aşağıdaki if şartını kaldırınca sorun giderildi.
Kod: 
If Cells(Z, "O") = "DÖŞEMELİ GRUPLAR" Then
end if
Ayrıca MsgBox "Kayıt işlemi tamamlanmıştır.", , "excel web tr" mesajından sonra aşağıdaki mesaj kutusu çıkıyor.
Bunu nasıl önleriz.
Yani hata yoksa mesaj vermesin.
Kod: 
MsgBox Cells(Z, "O") & " adlı sayfa bulunamadı!", vbCritical
 
Estağfurullah. Ben de o yollardan geçtim sonuçta.

Bu işin temeli, sütunu yok aslında. Ben de çok bilmiyorum. Burda ne öğrendiysem onları kullanmaya çalışıyorum. Tavsiyem, kullandığınız kodların ne işe yaradığını bilerek/öğrenerek yapmanızdır. "Orda bir satır var ama acaba ne işe yarıyor?" diye düşünürseniz çabuk yol alırsınız.
 
O if satırını gözden kaçırmışım, kusura bakmayın. Görüyorsunuz hatasız olmuyor :D

Kodun son hali aşağıdaki gibidir. Yalnız yerinizde olsam hatalı kayıtlara engel olmak için O sütununa Veri doğrulama ile doğru veri girilmesini sağlardım ve tüm sayfa adlarını bu veri doğrulamaya göre düzenlerdim:

Kod: 
Sub Dikdörtgen6_Tıklat()
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("TUMSIPARISLER")

Application.ScreenUpdating = False
'For Each ayni In Sheets("TUMSIPARISLER").Range("Z2:Z10000")
'   If ayni.Value = Range("F2").Value Then
'       DUR4 = MsgBox("KAYIT YAPTIĞINIZ SİPARİŞ NO DAHA ÖNCE KAYIT YAPILMIŞ.", vbYes, "MÜKERRER KAYIT")
'       Exit Sub
'   End If
'Next

If s1.Range("C2").Value = "" Then
    MsgBox "Sipariş Tarihini Giriniz."
    Exit Sub
End If

If s1.Range("F2").Value = "" Then
    MsgBox "Tiger Sip.No. Giriniz."
    Exit Sub
End If

If s1.Range("C3").Value = "" Then
    MsgBox "Cari seçiniz"
    Exit Sub
End If

If s1.Range("B8").Value = "" Then
    MsgBox "Ürün seçmediniz."
    Exit Sub
End If

m = MsgBox("KAYIT YAPILSIN MI.", vbYesNo, "Hevin / Planlama")
If m <> vbYes Then Exit Sub

Worksheets("TUMSIPARISLER").AutoFilterMode = False

For i = 8 To s1.Range("c655536").End(3).Row
    SONSTR = s2.Range("A65536").End(3).Row + 1
    s2.Cells(SONSTR, 1).Value = WorksheetFunction.Max(s2.[A2:A50000]) + 1
    s2.Cells(SONSTR, 2).Value = Date
    s2.Cells(SONSTR, 3).Value = "YENİ SİPARİŞ"
    s2.Cells(SONSTR, 7).Value = s1.Cells(i, 19).Value & " " & s2.Range("A65536").End(3).Row
    s2.Cells(SONSTR, 8).Value = s1.Cells(i, 2).Value
    s2.Cells(SONSTR, 9).Value = s1.Cells(i, 3).Value
    s2.Cells(SONSTR, 10).Value = s1.Cells(i, 7).Value
    s2.Cells(SONSTR, 11).Value = s1.Cells(i, 8).Value
    s2.Cells(SONSTR, 12).Value = s1.Cells(i, 9).Value
    s2.Cells(SONSTR, 13).Value = s1.Cells(i, 10).Value
    s2.Cells(SONSTR, 14).Value = s1.Cells(i, 11).Value
    s2.Cells(SONSTR, 15).Value = s1.Cells(i, 12).Value
    s2.Cells(SONSTR, 16).Value = s1.Cells(i, 13).Value
    s2.Cells(SONSTR, 17).Value = s1.Cells(i, 14).Value
    s2.Cells(SONSTR, 18).Value = s1.Range("C3").Value
    s2.Cells(SONSTR, 19).Value = s1.Range("C5").Value
    s2.Cells(SONSTR, 20).Value = s1.Range("C4").Value
    s2.Cells(SONSTR, 21).Value = s1.Cells(i, 15).Value
    s2.Cells(SONSTR, 22).Value = s1.Cells(i, 16).Value
    s2.Cells(SONSTR, 23).Value = s1.Cells(i, 17).Value
    s2.Cells(SONSTR, 24).Value = s1.Cells(i, 18).Value
    s2.Cells(SONSTR, 25).Value = s1.Cells(i, 19).Value
    s2.Cells(SONSTR, 26).Value = s1.Range("F2").Value
Next i


For Z = 8 To s1.Range("O655536").End(3).Row
    On Error GoTo 10
    
    SONSTR1 = Sheets(Cells(Z, "O").Value).Range("A65536").End(3).Row + 1
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 1).Value = WorksheetFunction.Max(Sheets(Cells(Z, "O").Value).[A2:A50000]) + 1
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 2).Value = Date
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 3).Value = "YENİ SİPARİŞ"
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 7).Value = s1.Cells(Z, 19).Value & " " & Sheets(Cells(Z, "O").Value).Range("A65536").End(3).Row
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 8).Value = s1.Cells(Z, 2).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 9).Value = s1.Cells(Z, 3).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 10).Value = s1.Cells(Z, 7).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 11).Value = s1.Cells(Z, 8).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 12).Value = s1.Cells(Z, 9).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 13).Value = s1.Cells(Z, 10).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 14).Value = s1.Cells(Z, 11).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 15).Value = s1.Cells(Z, 12).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 16).Value = s1.Cells(Z, 13).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 17).Value = s1.Cells(Z, 14).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 18).Value = s1.Range("C3").Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 19).Value = s1.Range("C5").Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 20).Value = s1.Range("C4").Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 21).Value = s1.Cells(Z, 15).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 22).Value = s1.Cells(Z, 16).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 23).Value = s1.Cells(Z, 17).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 24).Value = s1.Cells(Z, 18).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 25).Value = s1.Cells(Z, 19).Value
    Sheets(Cells(Z, "O").Value).Cells(SONSTR1, 26).Value = s1.Range("F2").Value
Next Z
GoTo 30
10:
    MsgBox Cells(Z, "O") & " adlı sayfa bulunamadı!", vbCritical
    GoTo 20
30
MsgBox "Kayıt işlemi tamamlanmıştır.", , "excel web tr"
20:
Application.ScreenUpdating = True

End Sub
 
merhaba,
O sutunundaki veriler parametre sahifesinden ürün seçme için açılan listbox dan geliyor.
Parametre sahifesinde veya sonradan müdahale sonucunda hata olması durumunu veri doğrulama ile kontrol edip kayıt yapmadan halletmek en doğrusu.
Tekrar teşekkür ederim hayırlı geceler dilerim.
Selametle
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst