• DİKKAT

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

run time eror 424 hatası

E

emre311

Katılım
16 Nisan 2010
Mesajlar
170
Excel Vers. ve Dili
Microsoft Office 2010 türkçe
Sub aktar()
Dim sat As Integer
Dim s, ss As Integer
Dim bul As Object
Kapak.[a23:n100].Clear
s = 23
ss = 23
son = Data.Cells(Rows.Count, "a").End(xlUp).Row
Set bul = Data.Range("a3:a" & son).Find(Kapak.[d16], , xlValues, xlWhole)
If Not bul Is Nothing Then
adres = bul.Address
Do
If Data.Cells(bul.Row, "j") = Kapak.[d19] Then
Kapak.Cells(s, "a") = Format(Data.Cells(bul.Row, "a"), "dd.mm.yyyy")
Kapak.Cells(s, "b") = Data.Cells(bul.Row, "b")
Kapak.Cells(s, "c") = Data.Cells(bul.Row, "c")
Kapak.Cells(s, "d") = Data.Cells(bul.Row, "d")
Kapak.Cells(s, "e") = Data.Cells(bul.Row, "e")
Kapak.Cells(s, "f") = Data.Cells(bul.Row, "f")
Kapak.Cells(s, "g") = Data.Cells(bul.Row, "g")
Kapak.Cells(s, "h") = Data.Cells(bul.Row, "h")
Kapak.Cells(s, "ı") = Data.Cells(bul.Row, "ı")
Kapak.Cells(s, "j") = Data.Cells(bul.Row, "j")
Kapak.Cells(s, "k") = Data.Cells(bul.Row, "k")
Kapak.Cells(s, "l") = Data.Cells(bul.Row, "l")
Kapak.Cells(s, "m") = Data.Cells(bul.Row, "m")
Kapak.Cells(s, "n") = Data.Cells(bul.Row, "n")
s = s + 1
End If
Set bul = Data.Range("a3:a" & son).FindNext(bul)
Loop While Not bul Is Nothing And bul.Address <> adres
End If
'*****
For sat = 2 To Data.Cells(Rows.Count, "a").End(xlUp).Row
If Kapak.[d16] = "" And Kapak.[d19] = "" Then
Kapak.Cells(s, "a") = Format(Data.Cells(bul.Row, "a"), "dd.mm.yyyy")
Kapak.Cells(s, "b") = Data.Cells(bul.Row, "b")
Kapak.Cells(s, "c") = Data.Cells(bul.Row, "c")
Kapak.Cells(s, "d") = Data.Cells(bul.Row, "d")
Kapak.Cells(s, "e") = Data.Cells(bul.Row, "e")
Kapak.Cells(s, "f") = Data.Cells(bul.Row, "f")
Kapak.Cells(s, "g") = Data.Cells(bul.Row, "g")
Kapak.Cells(s, "h") = Data.Cells(bul.Row, "h")
Kapak.Cells(s, "ı") = Data.Cells(bul.Row, "ı")
Kapak.Cells(s, "j") = Data.Cells(bul.Row, "j")
Kapak.Cells(s, "k") = Data.Cells(bul.Row, "k")
Kapak.Cells(s, "l") = Data.Cells(bul.Row, "l")
Kapak.Cells(s, "m") = Data.Cells(bul.Row, "m")
Kapak.Cells(s, "n") = Data.Cells(bul.Row, "n")
ss = ss + 1
End If
Next
End Sub


kodunda runtime eror 424 object required hatası veriyor bir türlü bulamadım sıkıntıyı yardımcı olurmusunuz şimdiden teşekkürler. birde bunu bir butonun tıklamasına bağlamak istiyorum.
 
Merhaba yukarıdaki kodlarda Data ve Kapak olarak kullandığınız işlemleri tanımlamadan kullandığınızdan sanırım hata ile karşılaşıyorsunuz.Sizin sayfa isimleriniz bunları Vba ekranı açtığınızda Sayfa ismi parantez içinde tanımlanan ad olarak gozukur Ornek( Sayfa1(Data) ) siz bugorunundeki Data yı değil Sayfa1 ismini kullanın..

Birde 2 dongu içerisinde bul.Row kullanmışsınız ilk dongude bulamassan işlem yapma demişsiniz fakat 2.donguda bunu kullanmadığınız için bulamadığı anda 2. dongu içerisinde hata vericektir.

Sizin Dosyanızda Data ve kapak sayfaların hangi sayfalar olduğunu bilmediğim için ben kapak sayfası için Sayfa2. Data sayfası içinde Sayfa1 kullanarak kodları duzenledim ..

Kod: 
Sub aktar()
Dim sat As Integer
Dim s, ss As Integer
Dim bul As Object
Sayfa2.[a23:n100].Clear
s = 23
ss = 23
son = Sayfa1.Cells(Rows.Count, "a").End(xlUp).Row
Set bul = Sayfa1.Range("a3:a" & son).Find(Sayfa2.[B3], , xlValues, xlWhole)
If Not bul Is Nothing Then
adres = bul.Address
Do
If Sayfa1.Cells(bul.Row, "j") = Sayfa2.[d19] Then
Sayfa2.Cells(s, "a") = Format(Sayfa1.Cells(bul.Row, "a"), "dd.mm.yyyy")
Sayfa2.Cells(s, "b") = Sayfa1.Cells(bul.Row, "b")
Sayfa2.Cells(s, "c") = Sayfa1.Cells(bul.Row, "c")
Sayfa2.Cells(s, "d") = Sayfa1.Cells(bul.Row, "d")
Sayfa2.Cells(s, "e") = Sayfa1.Cells(bul.Row, "e")
Sayfa2.Cells(s, "f") = Sayfa1.Cells(bul.Row, "f")
Sayfa2.Cells(s, "g") = Sayfa1.Cells(bul.Row, "g")
Sayfa2.Cells(s, "h") = Sayfa1.Cells(bul.Row, "h")
Sayfa2.Cells(s, "ı") = Sayfa1.Cells(bul.Row, "ı")
Sayfa2.Cells(s, "j") = Sayfa1.Cells(bul.Row, "j")
Sayfa2.Cells(s, "k") = Sayfa1.Cells(bul.Row, "k")
Sayfa2.Cells(s, "l") = Sayfa1.Cells(bul.Row, "l")
Sayfa2.Cells(s, "m") = Sayfa1.Cells(bul.Row, "m")
Sayfa2.Cells(s, "n") = Sayfa1.Cells(bul.Row, "n")
s = s + 1
End If
Set bul = Sayfa1.Range("a3:a" & son).FindNext(bul)
Loop While Not bul Is Nothing And bul.Address <> adres
End If
'*****

For sat = 2 To Sayfa1.Cells(Rows.Count, "a").End(xlUp).Row
If Not bul Is Nothing Then
If Sayfa2.[d16] = "" And Sayfa2.[d19] = "" Then
Sayfa2.Cells(s, "a") = Format(Sayfa1.Cells(bul.Row, "a"), "dd.mm.yyyy")
Sayfa2.Cells(s, "b") = Sayfa1.Cells(bul.Row, "b")
Sayfa2.Cells(s, "c") = Sayfa1.Cells(bul.Row, "c")
Sayfa2.Cells(s, "d") = Sayfa1.Cells(bul.Row, "d")
Sayfa2.Cells(s, "e") = Sayfa1.Cells(bul.Row, "e")
Sayfa2.Cells(s, "f") = Sayfa1.Cells(bul.Row, "f")
Sayfa2.Cells(s, "g") = Sayfa1.Cells(bul.Row, "g")
Sayfa2.Cells(s, "h") = Sayfa1.Cells(bul.Row, "h")
Sayfa2.Cells(s, "ı") = Sayfa1.Cells(bul.Row, "ı")
Sayfa2.Cells(s, "j") = Sayfa1.Cells(bul.Row, "j")
Sayfa2.Cells(s, "k") = Sayfa1.Cells(bul.Row, "k")
Sayfa2.Cells(s, "l") = Sayfa1.Cells(bul.Row, "l")
Sayfa2.Cells(s, "m") = Sayfa1.Cells(bul.Row, "m")
Sayfa2.Cells(s, "n") = Sayfa1.Cells(bul.Row, "n")
ss = ss + 1
End If
End If
Next
End Sub
 
hocam teşşeküür ederim yaptım fakat 2 problemim daha var.
* aldığım sayfadaki hücre formatıyla gelmesi (örnek olarak hücrede yazı uzun olduğundan alt satıra geçmesi ve kenarlıkları ile alması rengi vb.)
* 3 adet şartla yazdım herhangi biri boş ise diğer 2 şarta veya hepsi boş ise tüm verileri çekmesi şartını nasıl koyabilirim. şartlar çünkü 5 e 6 ya yükselebilir.
şimdiden teşekkürler.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst