DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Merhaba
Farklı excel dosyalarında aynı formatta verilerim mevcut başlık A1 satırı sabit kalacak aşağıya doğru diğer verileri eklemek istiyorum konu ile ilgili yardımlarınızı rica ederim.
Sub aktar59()
Dim dosya As String, yol As String, conn As Object, rs As Object, sonsat As Long
Range("A2:L" & Rows.Count).ClearContents
Set conn = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.recordset")
yol = ThisWorkbook.Path & "\konsolide\"
dosya = Dir(yol & "*.xls")
Do While dosya <> ""
conn.Open "Provider=microsoft.jet.oledb.4.0;data source=" & yol & dosya & ";extended properties=""excel 8.0;hdr=yes"""
rs.Open "select * from[Sheet0$];", conn, 1, 1
sonsat = Cells(Rows.Count, "A").End(xlUp).Row + 1
If rs.RecordCount > 0 Then Range("A" & sonsat).CopyFromRecordset rs
rs.Close: conn.Close
dosya = Dir
Loop
Set rs = Nothing: Set conn = Nothing
MsgBox "İşlem tamamdır." & vbLf & "evrengizlen@hotmail.com"
End Sub
Rica ederim.Evren bey çok teşekkürler kontrol edip dönüyorum size
Evren Bey çok teşekkür ederim elinize sağlık tam istediğim gibi oldu