Çözüldü "*" İçeren Hücre Silinmesi ve Kayıt Hk.

[RBozkurt]

Merhabalar.

Ekte arkadaşımın hazırlamış olduğu formüllü bir çalışma dosyası var.
Normalde NetKamu ve Direk Bilgi sayfaları gizli.
Çalışma mantığı Veri Giriş sayfasına girilen veriler ile NetKamu sayfasındaki liste oluşturuluyor.
Örnek olarak ben doldurdum.

Verileri girip kaydetme işlemini "*.xls" uzantısı olarak makro ile yapıyoruz.
Kaydetme işlemini sadece NetKamu sayfası ve A sütununda bulunan "*" içeren hücrelerin silinerek kaydedilmesi konusunda yardımcı olabilirseniz seviniriz.
Teşekkür ederim.

 

[Necdet]

Merhaba,
Deneyiniz.

Sub Kaydet()

    Application.ScreenUpdating = False

    Dim i As Long
    Dim c As Range
    
    i = Sheets("NetKamu").Cells(Rows.Count, "A").End(3).Row
    Set c = Sheets("NetKamu").Range("A:A").Find("~*", LookIn:=xlValues)
    If Not c Is Nothing Then
        If Not i = c.Row Then Sheets("NetKamu").Rows(c.Row & ":" & i).Delete
    End If
    
    isim = ThisWorkbook.Name
    ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Date & " NetKamu Direk Bilgileri" & ".xls", FileFormat:=56
    
    Application.ScreenUpdating = True
    
    MsgBox "NetKamu gabari kontrolü için Direk Bilgileri içeren dosya kaydedildi.", vbInformation, "ENH Şablon 4.0 Mustafa DERE"

End Sub

 

[RBozkurt]

Merhaba sayın @Necdet bey
Denedim ama aşağıdaki gibi hata verdi. Birde silme işlemini Veri Giriş sayfasında yaptı.

Bu veri formülle seçildiği için aynı veri üzerinde kopyala/değer yapıştır işlevide olması lazım. Diğer sayfa silinip bunu ayrı kaydederse yine hata verir.

 

[Necdet]

Merhaba,
NetKamu sayfası bende aktif olduğu için sayfa adına dikkat etmemişim
kodları yeniledim, dener misiniz?

 

[RBozkurt]

Merhaba,
NetKamu sayfası bende aktif olduğu için sayfa adına dikkat etmemişim
kodları yeniledim, dener misiniz?

Teşekkür ederim sayın @Necdet bey. Elinize sağlık.
Kaydetme kısmında biraz değişiklik yaptım. Son kodlar aşağıdaki gibi. İstediğimiz şekilde sonuçlandı.

Sub Kaydet()

    Application.ScreenUpdating = False

    Sheets("NetKamu").Visible = True

    Sheets("NetKamu").Copy
    Dim i As Long
    Dim c As Range
   
    i = Sheets("NetKamu").Cells(Rows.Count, "A").End(3).Row
    Set c = Sheets("NetKamu").Range("A:A").Find("~*", LookIn:=xlValues)
    If Not c Is Nothing Then
        If Not i = c.Row Then Sheets("NetKamu").Rows(c.Row & ":" & i).Delete
    End If
           
    baslik_ismi = "1 - NetKamu Direk Bilgileri ("
       
        ActiveWorkbook.SaveAs Filename:= _
        ThisWorkbook.Path & "\" & baslik_ismi & Date & ")" & ".xls", FileFormat:=xlExcel8, _
        CreateBackup:=False
        ActiveWindow.Close
   
    Sheets("NetKamu").Visible = False
   
    MsgBox "NetKamu gabari kontrolü için Direk Bilgileri içeren dosya kaydedildi.", vbInformation, "ENH Şablon 4.1 Mustafa DERE"

End Sub