Eğer verilerin geleceği Excel Formatı xlsx değilse If Not yol2 Like "00 -Tüm Veri*" Thenve End if kısmını silebilirsiniz.Bende bu dosyada pasif yaptım.
A sütunudaki gereksiz satırları silinki doğru çalışsın alt alta.
Private Sub CommandButton1_Click()
Dim rs As Object, con As Object, Sql As String
Set rs = CreateObject("ADODB.Recordset")
Set con = CreateObject("ADODB.Connection")
Dim yol As String, yol2 As String
yol = ThisWorkbook.Path & Application.PathSeparator
yol2 = Dir(yol & "*xlsx")
With ThisWorkbook.Sheets("TümVeri")
.Range("A2:Q" & Rows.Count).Clear
Do Until yol2 = ""
' If Not yol2 Like "00 -Tüm Veri*" Then
con.Open "Provider=microsoft.ace.oledb.12.0;data source=" & yol & yol2 & ";extended properties=""Excel 12.0;hdr=yes"""
Sql = Sql & " union all select * from [MEMURLAR$]"
Sql = Mid(sql, 12)
rs.Open sql, con, 1, 1
.Range("A" & Rows.Count).End(3)(2, 1).CopyFromRecordset rs
Sql = ""
rs.Close
con.Close
' End If
yol2 = Dir
Loop
End With
Set rs = Nothing
Set con = Nothing
MsgBox "Bitti", vbInformation, "Bilgi"
End Sub
