hücre boşsa hücrenin olduğu satırı silme

[udentr2002]

hocam

hem sayfa1 de hemde sayfa2 de A:A arasında boşluk olan satırım yok ama yinede aynı hatayı veriyor
2. sroum ise Sayfa1 de M stünunda sıfır değerini görür görmez aynı işlemi yapabilirmi yani sayfa1 e tıkladığımızda değilde sayfa1' e M stünuna sıfır yazılır yazılmaz o satırı silip sayfa2 ye taşıması ancak sıfır yazdığı hücreden sonraki verileride aynen taşımalı sayfa2 ye tekrar teşekkür ederim hocam

 

[bedersu]

A:A 'dan kastım şuradaki A:A

sıra = WorksheetFunction.CountA(Sheets("Sayfa2").Range("A :A"))
aradaki boşluğu kaldırın.

Benim vermiş olduğum kodlarda da zaten sıfır yazılır yazılmaz taşınıyor.Diğer yerlere ne yazarsanız yazın satır silinmez.
Yok siz daha hücrenin içindeyken yani imleç yanıp sönerken kod çalışsın diyorsanız bunu mümkün olabileceğini sanmıyorum.Bilen varsa da öğrenmeyi isterim.

 

[udentr2002]

hocam

hocam ben o kodu Auto_open kodunun altına yazdım yanlız dosya kapanıp açıldığında sadece sıfır gördüğü tek satırı silip sayfa2 ye yazıyor her açılıp kapandığında sadece tek satırı taşıyor yani her kapanıp açıldığında sayfa1 deki gördüğü tüm sıfırlı satırları taşıması için ne yapabilirim tekrar tekrar ilginiz için çok çok teşekkür ederim hocam

 

[udentr2002]

??

Yardım edebilecek bir hocam yokmu ? Değerli bedersu üstadın vermiş olduğu kodu Auto_open kodunun altına yazdım Sayfa1 deki M stünunda Sıfır değerini görüp o satırı silip Sayfa2 ye yapıştırıyor yanlız sorun şu Sayfa1 de gördüğü tüm sıfır değerlerini silip Sayfa2 ye yapıştırmıyor bir kaç tane satırı yine Sayfa1 de bırakıyor aşağıda kodu verdim dosya her açıldığında Sayfa1 deki tüm sıfır gördüğü satırı silip Sayfa2 ye yazması için nasıl değiştirmem lazım ben bir sürü yold enedim saatlerce ama bir türlü beceremedim üstatlar kod aşağıda

Sub auto_open()

Sheets("Sayfa1").Select
For Each satır In Range("M4:M65536")

If satır = "0" Then
sıra = WorksheetFunction.CountA(Sheets("Sayfa2").Range("A:A"))
satır.Select
adr = satır.Address
Selection.EntireRow.Copy
Sheets("Sayfa2").Range("a" & sıra + 3).PasteSpecial
Sheets("Sayfa1").Range(adr).EntireRow.Delete

End If
Next




End Sub

 

[Orion1]

Merhaba.
Var olan Autpen Prosedürünü siliniz ve O modüle aşağıdaki kodu kopyalayıp yapıştırıp bir deneyiniz.

Sub Auto_Open()
Dim sayfa1_sonsat As Long, i As Long
sayfa1_sonsat = Sheets("Sayfa1").Cells(65536, "M").End(xlUp).Row
Sheets("Sayfa2").Range("A1:M65536").ClearContents
For i = 1 To sayfa1_sonsat
If Sheets("Sayfa1").Cells(i, "M").Value = "0" Then
    Sheets("Sayfa1").Rows(i).Copy
    Sheets("Sayfa2").Cells(Sheets("Sayfa2").Cells(65536, "M").End(xlUp).Row + 1, "A").PasteSpecial
    Sheets("Sayfa1").Rows(i).Delete
    i = i - 1
End If
Next
End Sub

Eğer sayfa2'yi her tıkladığınızda Sayfa2'ye Otomatik olarak sıfırlı satırların akatarılmasın istiyorsanız?
Sayfa2'nin sayfa sekmesine sağ klik tıklayınız,Kod görünteleye tıklayınız.Ve açılan vba editörüne aşağıdaki kodu kopyalayıp yapıştırınız.
İnşallah istediğiniz olmuştur.

Private Sub Worksheet_Activate()
Dim sayfa1_sonsat As Long, i As Long
sayfa1_sonsat = Sheets("Sayfa1").Cells(65536, "M").End(xlUp).Row
'Sheets("Sayfa2").Range("A1:M65536").ClearContents
For i = 1 To sayfa1_sonsat
If Sheets("Sayfa1").Cells(i, "M").Value = "0" Then
    Sheets("Sayfa1").Rows(i).Copy
    Sheets("Sayfa2").Cells(Sheets("Sayfa2").Cells(65536, "M").End(xlUp).Row + 1, "A").PasteSpecial
    Sheets("Sayfa1").Rows(i).Delete
    i = i - 1
End If
Next
End Sub

 

[udentr2002]

(

Hocam malasef olmadı ya sıfır olan değerler olduğu gibi duruyor Ben auto open kduna yazdım ama çalışmadı hocam

 

[udentr2002]

hocam özür dilerim

Ben kodun bir yerinde yanlış bir şey yapmışım çalışıyor çok çok özür dilerim Auto open kodunda olursa çalışıyor ama iknci aktivate bölümünde ise bir döngü hatası var sanırım ama auto open da çalışması benim işimi görüyor teşekkür ederim hocam ilgine ve emeğine sağlık Hakkını helal et Allah razı olsun

 

[bedersu]

Sayın udentr2002,
kusura bakmayın dün hiç giremedim internete doğru dürüst.Bu yüzden de çözüm üretemedim ve belki de işlerinizin aksamasına sebep oldum.Ama satın SEZAR imdadınıza yetişmiş.Allah razı olsun.
Hakkınızı helal edin.

 

[udentr2002]

bedersu hocam

Asıl siz hakkınızı helal edin duyarlılığınız vede ilginiz için ayrıca çok teşekkür ederim Allah razı olsun sizden

 

[quman]

Hepinize çok teşekkür ederim, özellikle değerli üstat COST_CONTROL'a.

 

[macay]

Bu konuya cevap veren tüm üstadlar...Bilginize sağlık Allah sizlerden razı olsun..İşimi çok güzel gördü