Ayrı dosyalardaki verileri tek dosyada birleştirmek

[hadromer]

Merhabalar,
Bir klasör içerisinde 1-44 isim aralığında 44 adet dosyam mevcut.

Dosya isimleri ile sayfa isimleri aynı. Örneğin 1 numaralı dosyanın içindeki sayfa ismi de 1. Dosya içerisindeki sütun formatı sabit.
Ben bu dosya içerisindeki verileri bir dosyada belirli bir formatta birleştirmek istiyorum. Fakat bazı istisnai durumlarım var. O yüzden sayfada daha önce açılmış birleştirme konularını uygulayamadım.
Dosyalarımın içeriği şöyle ; ( Tekrar edenleri ben renklendirdim, normalde renkli değil)

Birleştirmek istediğim format ise şöyle ; ( Dosya isimlerinin başına "S" gelecek, S1 şeklinde olmalı)

Sol sütuna dosya isimleri gelecek. üst satırlarda da Dosyaların A sütunlarındaki kodlar "küçükten büyüğe doğru sıralı ve tekrar etmeyecek şekilde" yan yana sıralanacak. Şöyle bir durum var ; Bazı dosyaların içerisinde kodlar tekrar ediyor. Örneğin 2 numaralı dosya içerisinde üç tane 212 var. her bir 212 satırının karşısında farklı bir değer var. Bunların toplanıp tek veriye indirilmesi lazım. Bu şekilde toplanarak üstteki formatta birleşmesi gerekiyor. Aşağıya örnek dosyaları ekledim. Umarım net bi şekilde anlatabilmişimdir. Bu konu hakkında yardımcı olabilir misiniz ? Teşekkür ederim.

ÖRNEK DOSYALAR

 

[hadromer]

Bu konudaki sorunum çözülmüştür.

 

[veyselemre]

Sub veriCek()
'DataCek isminde sayfa oluşturulacak.
'Dosya xlsm olarak kaydedilecek.

    Dim adoCN As Object, rs As Object
    Dim fileName$, sayfa$, strSql$
    Dim sql(0 To 1), sh(0 To 1), i%, ii&, form(0 To 1), son&
    
    Sheets("DataCek").Select
    Cells.ClearContents
    Cells(1, 1).Resize(, 4).Value = Array("İstasyon/Kod", "Kod", "Area", "Land")

    Set adoCN = CreateObject("ADODB.Connection")
    Set rs = CreateObject("Adodb.RecordSet")
    adoCN.Provider = "Microsoft.ACE.OLEDB.12.0"
    adoCN.Properties("Data Source") = ThisWorkbook.FullName
    adoCN.Properties("Extended Properties") = "Excel 12.0; HDR=Yes"
    adoCN.Open

    fileName = Dir(ThisWorkbook.Path & "\*.xlsx")

    Do While fileName <> "" And fileName <> "corine_demo.xlsx"
        sayfa = Replace(fileName, ".xlsx", "")
        strSql = "SELECT '" & "S" & sayfa & "', * FROM [" & sayfa & "$] IN '' [Excel 12.0;Database=" & ThisWorkbook.Path & "\" & fileName & "]"
        rs.Open strSql, adoCN
        Cells(Rows.Count, 1).End(3).Offset(1).CopyFromRecordset rs
        rs.Close
        fileName = Dir()
    Loop

    Columns.AutoFit

    sh(0) = "Km"
    sh(1) = "Yüzde"
    form(0) = "#,##0.00"
    form(1) = "#,##0.00%"
    sql(0) = "TRANSFORM SUM([Area]) SELECT [İstasyon/Kod] FROM [DataCek$] GROUP BY [İstasyon/Kod] ORDER BY [İstasyon/Kod] PIVOT [Kod]"
    sql(1) = "TRANSFORM SUM([Land]) SELECT [İstasyon/Kod] FROM [DataCek$] GROUP BY [İstasyon/Kod] ORDER BY [İstasyon/Kod] PIVOT [Kod]"

    For i = 0 To 1
        Sheets(sh(i)).Select
        Cells.Clear
        rs.Open sql(i), adoCN

        For ii = 0 To rs.Fields.Count - 1
            With Cells(1, ii + 1)
                .Clear
                .Value = rs.Fields(ii).Name
                .Font.Bold = True
                .Font.Color = vbWhite
                .Interior.Color = vbBlack
                .HorizontalAlignment = xlCenter
            End With
        Next ii

        Cells(2, 1).CopyFromRecordset rs
        son = Cells(Rows.Count, 1).End(3).Row
        Cells(2, 1).Resize(son, ii).NumberFormat = form(i)
        rs.Close
        Columns.AutoFit
    Next i

    adoCN.Close
    Set rs = Nothing
    Set adoCN = Nothing

End Sub