Çözüldü Boş Satır Olunca Makroda Hata

[ywzyilmaz]

Merhaba

Bir sayfadaki alt alta dizili verileri alıp uygun yerlere doldurup yazan bir makro hazırladım.

Listede boşluk olmadığında

Elma	1
Armut	2
Ayva	3
Kiraz	4

Sub formulsave()
sons = Sayfa5.Range("A" & Rows.Count).End(xlUp).Row
For a = 2 To Sayfa1.Range("E19").End(xlUp).Row
yaz = Sayfa1.Cells(a, "F")
Sayfa5.Cells(sons, yaz) = Sayfa1.Cells(a, "E")
Next a
End Sub

Düzgün şekilde çalışıyor.


Fakat şöyle arada bir satır boşluk olduğu zaman ;

Elma	1
Armut	2
Ayva	3

Sayfa5.Cells(sons, yaz) = Sayfa1.Cells(a, "E")

Bu satırda hata alıyorum.

Nedeni ve nasıl çözebileceğimle ilgili paylaşım olursa çok memnun olurum.

İyi forumlar.

 

[AdemCan]

Merhaba, dener misiniz?

Sub formulsave()
sons = Sayfa5.Range("A" & Rows.Count).End(xlUp).Row
    For a = 2 To Sayfa1.Range("E19").End(xlUp).Row
        yaz = Sayfa1.Cells(a, "F")
            If yaz = "" Then GoTo atla
                Sayfa5.Cells(sons, yaz) = Sayfa1.Cells(a, "E")
atla:
    Next a
End Sub

 

[ywzyilmaz]

Yine aynı hatayı alıyorum.

 

[AdemCan]

Dosyanızı paylaşır mısınız?

 

[ywzyilmaz]

Dosyanızı paylaşır mısınız?

Merhaba
https://s6.dosya.tc/server10/5e9ew0/recetebarkod.xlsm.html

Dosyada bir çok makro ekli. "formulsave" adlı makroyu inceler misiniz?

 

[Mustafa MUTLU]

Sayfa isimlerini kontrol et.
Boş dediğin hücrede sıfır olabilirmi acaba ?

Sub formulsave()
sons = Sayfa5.Range("A" & Rows.Count).End(xlUp).Row
For a = 2 To Sayfa1.Range("E19").End(xlUp).Row
If Sayfa1.Cells(a, "F") < 1 Then GoTo Git 'Hücrede formül yada 0 olabilir.
yaz = Sayfa1.Cells(a, "F")
Sayfa5.Cells(sons, yaz) = Sayfa1.Cells(a, "E")
Git:
Next a
End Sub

 

[ywzyilmaz]

Sayfa isimlerini kontrol et.
Boş dediğin hücrede sıfır olabilirmi acaba ?

Sub formulsave()
sons = Sayfa5.Range("A" & Rows.Count).End(xlUp).Row
For a = 2 To Sayfa1.Range("E19").End(xlUp).Row
If Sayfa1.Cells(a, "F") < 1 Then GoTo Git 'Hücrede formül yada 0 olabilir.
yaz = Sayfa1.Cells(a, "F")
Sayfa5.Cells(sons, yaz) = Sayfa1.Cells(a, "E")
Git:
Next a
End Sub

E sütunundaki hücrelerde 0 olduğunda makro döngüsünde problem olmuyor. Makro çalışıyor ama sıfırlar datada boşa yer tuttuğu için 0 olan satırları temizlemek için bundan önce şu formülü çalıştırıyorum.

Sub sifirla()
    Dim Bul As Range
    Do
        Set Bul = Range("E1:E19").Find(what:=0, lookat:=xlWhole)
        If Bul Is Nothing Then
            Exit Sub
        End If
        Bul = ""
        Cells(Bul.Row, "D") = ""
    Loop
End Sub

bu formül satırları temizledikten sonra hata alıyor.

 

[ywzyilmaz]

Tekrardan merhaba şöyle çözdüm.

Sub formulsave()
sons = Sayfa5.Range("A" & Rows.Count).End(xlUp).Row
    For a = 2 To Sayfa1.Range("E19").End(xlUp).Row
        yaz = Sayfa1.Cells(a, "F")
            If Sayfa1.Cells(a, "D") = "" Then GoTo atla
                Sayfa5.Cells(sons, yaz) = Sayfa1.Cells(a, "E")
atla:
    Next a
End Sub