+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme (/konu-klasor-icerisindeki-excel-dosyalarini-tek-dosyada-birlestirme.html)
RE: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme - feraz - 22/04/2021
Aslında düşününce union all olayına gerek yok abey ektekini deneyin.
Private Sub CommandButton1_Click()
Dim rs As Object, con As Object
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 = ""
con.Open "Provider=microsoft.ace.oledb.12.0;data source=" & yol & yol2 & ";extended properties=""Excel 12.0;hdr=yes"""
rs.Open "select * from [MEMURLAR$]", con, 1, 1
.Range("A" & Rows.Count).End(3)(2, 1).CopyFromRecordset rs
rs.Close
con.Close
yol2 = Dir
Loop
End With
Set rs = Nothing
Set con = Nothing
MsgBox "Bitti", vbInformation, "Bilgi"
End SubRE: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme - yyhy - 22/04/2021
Sayın feraz öncelikle teşekkür ederim. Klasördeki BİRİM (1) dosyasındaki verileri getiriyor. Tam istediğim gibi ama geriye 49 dosya var yani BİRİM (2)........BİRİM (50) ye kadar. Acaba kodda nasıl bir düzenleme yapabiliriz.
RE: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme - feraz - 22/04/2021
Rica ederim abey normalde getiriyor mesela 300.stırdan itibaren bakın.A stunundaki gereksiz satırları silin diye.Ayrıca son stırı buldurupta yaptırılabilir müsit olunca bakarım.
RE: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme - feraz - 22/04/2021
Vakit bulmuşken ayarladım abey.
Private Sub CommandButton1_Click()
Dim rs As Object, con As Object
Dim son As Long
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 = ""
son = .Range("B" & Rows.Count).End(3).Row + 1
con.Open "Provider=microsoft.ace.oledb.12.0;data source=" & yol & yol2 & ";extended properties=""Excel 12.0;hdr=yes"""
rs.Open "select * from [MEMURLAR$]", con, 1, 1
.Range("A" & son).CopyFromRecordset rs
rs.Close
con.Close
yol2 = Dir
Loop
son = .Range("B" & Rows.Count).End(3).Row + 1
.Range("A" & son & ":A" & Rows.Count).Clear
End With
Set rs = Nothing
Set con = Nothing
MsgBox "Bitti", vbInformation, "Bilgi"
End SubRE: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme - yyhy - 22/04/2021
Sayın feraz bey acaba verileri aldığı Birim (01).....Birim (50) sayfalardan veriyi alırken B2:Q aralığını aldırmam için macro kodunda ne gibi değişiklik yapabiliriz? Ayrıca son gönderdiğiniz macroyu deneyeceğim. Teşekkürler. Ayrıca bilgi vereceğim.
RE: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme - feraz - 22/04/2021
Önceki mesajdajdaki dosyayı eklemeyi unutmuşum abey.
(22/04/2021, 21:49)yyhy yazdı: Birim (01).....Birim (50) sayfalardan veriyi alırken B2:Q aralığını aldırmam için macro kodunda ne gibi değişiklik yapabiliriz?
Private Sub CommandButton1_Click()
Dim rs As Object, con As Object
Dim son As Long
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 = ""
son = .Range("B" & Rows.Count).End(3).Row + 1
con.Open "Provider=microsoft.ace.oledb.12.0;data source=" & yol & yol2 & ";extended properties=""Excel 12.0;hdr=yes"""
rs.Open "select * from [MEMURLAR$B1:Q]", con, 1, 1
.Range("B" & son).CopyFromRecordset rs
rs.Close
con.Close
yol2 = Dir
Loop
End With
Set rs = Nothing
Set con = Nothing
MsgBox "Bitti", vbInformation, "Bilgi"
End Sub