kapalı çoklu dosyalardan a sütununa göre boş satır silme

[caytug]

Arkadaşlar İyi günler, şöyle bir ihtiyaç hasıl oldu mümkünse

1- çoklu kapalı dosyalardan seçilerek işlem yapılacak,
2- Tüm dosyaların başlık satırları silinecek,
3- Tüm dosyaların a sütununa göre boş olan satırlar silinecek (600 satıra kadar),
4- Tüm dosyaların boş satırları silindikten sonra, kalan dolu satırlarda a sütununa göre mükerrer olan satırlar oluyor, mükerrer satırlarda silinmesi gerekiyor.

örnek dosyaları ekledim, yardımlarınız için teşekkürler.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Dosyalari_Duzenle()
    Dim XL_App As Object, K1 As Object, S1 As Object, X As Byte
    Dim Dosya As Variant, Bos_Alan As Range, Zaman As Double
  
    Dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyası, *.xls; *.xlsx; *.xlsm", MultiSelect:=True)
  
    If IsArray(Dosya) = False Then
        MsgBox "İşleme devam edebilmeniz için düzenleme yapmak istediğiniz dosyaları seçmelisiniz!", vbCritical
        Exit Sub
    End If
  
    Zaman = Timer
  
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
  
    Set XL_App = CreateObject("Excel.Application")
    XL_App.Visible = False
  
    For X = LBound(Dosya) To UBound(Dosya)
        If Dosya(X) <> ThisWorkbook.FullName Then
            Set K1 = XL_App.Workbooks.Open(Dosya(X))
            Set S1 = K1.Sheets("Sheet0")
           
            On Error Resume Next
            Set Bos_Alan = Nothing
            Set Bos_Alan = S1.Range("A2:A" & S1.Rows.Count).SpecialCells(xlCellTypeBlanks)
            On Error GoTo 0
            If Not Bos_Alan Is Nothing Then Bos_Alan.EntireRow.Delete
           
            S1.Range("A1:J" & S1.Rows.Count).RemoveDuplicates Columns:=1, Header:=xlYes
           
            S1.Rows(1).Delete xlUp
           
            K1.Close True
        End If
    Next
  
    XL_App.Quit
  
    Set S1 = Nothing
    Set K1 = Nothing
    Set XL_App = Nothing
  
    Application.Calculation = -4105
    Application.ScreenUpdating = 1
  
    MsgBox "Seçtiğiniz dosyalar düzenlenmiştir." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[caytug]

Sayın Korhan, çok teşekkürler ellerinize sağlık, mükemmel olmuş.