Kapalı dosyada satır silme

[alooo]

ana sayfa içerisinde verilen tarihe göre kapalı dosyadaki verileri süzerek istenilen alanda görüntüleyip, silinmek istenilen veriler seçildikten sonra kapalı dosyada, silinmek istenilen satırların silinmesini sağlayacak bir makro arıyorum. mümkünse yardım edebilir misiniz?

Ekli örnek dosyada istenilen şey, daha açık bir şekilde yazılmıştır.

örnek dosya linki

 

[FERAZ]

Sayfa koduna yapıştırınız anasayfa kitabının.

http://www.dosyaupload.com/4R31

Dim aa As Date, bb, cc, dd, ee As Variant

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row >= 5 And Target.Column = 6 And Target.Count = 1 Then

If Target.Value = "SİL" Then

aa = Target.Offset(0, -5).Value
bb = Target.Offset(0, -4).Value
cc = Target.Offset(0, -3).Value
dd = Target.Offset(0, -2).Value
ee = Target.Offset(0, -1).Value

verisl

End If

End If

End Sub

Sub verigetir()

Dim say As Integer, bul As Range

Dim kapal, ack As String

kapal = "firma.xlsx"
ack = "anasayfa.xlsm"

Application.ScreenUpdating = False

dosya = ThisWorkbook.Path & "\firma.xlsx"

 If Dir(dosya) = "" Then
    MsgBox "Dosya Yok."
    Exit Sub
 End If
     
     
With Workbooks(ack).Sheets("Sayfa1")
    .Range("A5:E" & Rows.Count).ClearContents
    
Workbooks.Open dosya

say = 5
      Workbooks(ack).Activate
      
   Set bul = Workbooks(kapal).Sheets("Sayfa1").Range("A:A").Find(.Range("a2").Value, , , 1)
      
      If Not bul Is Nothing Then
            adresss = bul.Address
            Do
               .Range("A" & say).Value = bul.Value
                .Range("B" & say).Value = bul.Offset(0, 1).Value
                .Range("C" & say).Value = bul.Offset(0, 2).Value
                .Range("D" & say).Value = bul.Offset(0, 3).Value
                .Range("E" & say).Value = bul.Offset(0, 4).Value
                say = say + 1
            Set bul = Workbooks(kapal).Sheets("Sayfa1").Range("A:A").FindNext(bul)
            Loop While Not bul Is Nothing And bul.Address <> adresss
        End If
      

    Workbooks(ack).Activate
    Application.DisplayAlerts = False
    Workbooks(kapal).Save
    Workbooks(kapal).Close False
    Application.DisplayAlerts = True
      
End With

  Application.ScreenUpdating = True
   
End Sub

Sub verisl()

Dim bul, bul2 As Range

Dim kapal As String, xyz() As Variant

kapal = "firma.xlsx"
ack = "anasayfa.xlsm"
   dosya = ThisWorkbook.Path & "\firma.xlsx"
    sayyy = 0

Application.ScreenUpdating = False
If Dir(dosya) <> "" Then Workbooks.Open dosya

With Workbooks(kapal).Sheets("Sayfa1")

      Workbooks(kapal).Activate
      
      
      Set bul = Workbooks(kapal).Sheets("Sayfa1").Range("A:A").Find(aa, , , 1)
      
If Not bul Is Nothing Then
    adresss = bul.Address
    
    Do
        For Each bul2 In Workbooks(kapal).Sheets("Sayfa1").Range(bul.Offset(0, 1).Address)
        
            If bul2.Value = bb And bul2.Offset(0, 1).Value = cc And bul2.Offset(0, 2).Value = dd And bul2.Offset(0, 3).Value = ee Then
                Workbooks(kapal).Sheets("Sayfa1").Rows(bul2.Row).EntireRow.Delete
                GoTo var
            End If
        Next
        
        Set bul = Workbooks(kapal).Sheets("Sayfa1").Range("A:A").FindNext(bul)
    Loop While Not bul Is Nothing And bul.Address <> adresss

End If

var:

Workbooks(ack).Activate
Application.DisplayAlerts = False
Workbooks(kapal).Save
Workbooks(kapal).Close False
Application.DisplayAlerts = True
End With

  Application.ScreenUpdating = True
   
End Sub

 

[alooo]

Üstadım,
Öncelikle gecikmeli bu cevap için çok ama çok özür dilerim. Zira, iş yoğunluğu nedeni ile neredeyse 1 haftadır ilk defa makine başına oturabildim desem yeridir. Lütfen bu özrümü kabul buyur.

Kodlarda bazı değişiklikler yaparak işimi hallettim üstadım. Bu hususla ilgili de teşekkür ederim.
Saygılarımla,

 

[alooo]

Üstadım,
Yazmış olduğun makroda her sil hücresi aktif olduğunda makro çalışıyor. Ancak, bunu silinecek veriler seçildikten sonra, Sil butonu aracılığıyla tek seferde hepsini (sil işaretli olan veriler) silecek şekle çevirmemiz mümkün müdür?

(for next falan denedim ancak bir türlü yapamadım )