Birden fazla Excel dosyasında aranan bir kelimenin, tek Excel dosyasında sıralanması.

[kahraman.akosman]

X klasörümde yer alan birden fazla Excel dosyalarım bulunmaktadır. Bu excel dosyalarımın içerisinde "engelli" kelimesinin olduğu satırların farklı bir Excel dosyasında birleştirerek alt alta sıralamak istiyorum.

Bunu nasıl yapabilirim ??

Not: Dosyaların sayısı çok fazla.. "Engelli" kelimesini tek tek bulmakta zorlandığım için sadece 2 farklı örnek dosya ekte yer almaktadır. Formülde ekte yer alan Birleştirilecek dosya üzerinde yapılacaktır... Teşekkürler ...

 

[Necdet]

Merhaba,

Kodları Deneyiniz.

Sub DosyaSec()

    Dim fd As FileDialog
    Dim vrtSelectedItem As Variant
    
    Range("A1").CurrentRegion.Offset(2).ClearContents
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    With fd

        .Filters.Clear
        .Filters.Add "All files", "*.*"
        .Filters.Add "Images", "*.xls; *.xlsx; *.xlsm", 1
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                DosyaYaz (vrtSelectedItem)
            Next vrtSelectedItem
        Else
            MsgBox "Hiç Bir Dosya Seçilmedi"
            Exit Sub
        End If
    End With

    Set fd = Nothing
    
 End Sub

 Sub DosyaYaz(DosyaAdi As Variant)
 
    Dim i       As Long
    Dim DB      As Object
    Dim RS      As Object
    Dim SQLStr  As String
    
    Set DB = CreateObject("adodb.Connection")
    Set RS = CreateObject("adodb.Recordset")
    DB.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}; DBQ=" & DosyaAdi
    RS.CursorLocation = adUseClient
    RS.CursorType = adOpenDynamic
    RS.LockType = adLockOptimistic

    SQLStr = "SELECT * FROM [Sayfa1$] WHERE F13 = 'Engelli' "

    RS.Open SQLStr, DB, adOpenDynamic, adLockPessimistic, -1

    i = Cells(Rows.Count, "C").End(3).Row + 1
    If i < 3 Then i = 3
    
    Range("A" & i).CopyFromRecordset RS

    DB.Close
    
    Set DB = Nothing
    Set RS = Nothing
    
End Sub

 

[kahraman.akosman]

Teşekkür ederin bilgilendirme için. Fakat ben makro kullanamıyorum O yüzden yapamıcam galiba.

 

[Necdet]

Gönderdiğim dosyayı açıp makroyu çalıştıracaksınız.
Hepsi bu

 

[kahraman.akosman]

Denedim oldu, çalışma arkadaşlarıma birlikte size çok dua ediyoruz. Allah razı olsun.. teşekkürler...

 

[kahraman.akosman]

Engelli kelimelerinde büyük küçük harf duyarlı mıdır ? Örneğin "engelli", "Engelli" ve "ENGELLİ" olan tüm kelimeleri alıyor mu? Almıyor gibime geldi..

 

[Necdet]

Almıyor olabilir.

 

[kahraman.akosman]

Evet denemedim almadı. Bunun bir çözümü varmıdır acaba ?