dosya birleştir

[aligunes]

Dim sayfaadi, ilkkolonadi, sonkolonadi As String

Sub kayitoku()

sonsatir = Sheets(sayfaadi).Range(ilkkolonadi + "65536").End(xlUp).Row
kolon = ilkkolonadi + "1:" & sonkolonadi & sonsatir
Range(kolon).Select
Selection.Copy
Windows("dosya_birlestir.xls").Activate

sonsatir = Sheets("liste").Range(ilkkolonadi + "65536").End(xlUp).Row

sec = ilkkolonadi & sonsatir + 1
Range(sec).Select
ActiveSheet.Paste

End Sub


Sub anamenu()
Dim ds, dc, f, s

'Tanımlamalar
sayfaadi = "Sayfa1"
dosyadizini = "c:\excel\"
ilkkolonadi = "L"
sonkolonadi = "M"

Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder(dosyadizini)
Set dc = f.Files
For Each dosya In dc
dosyaadi = dosya.Name
If Right(dosyaadi, 3) = "xls" Then
dosya = dosyadizini + dosyaadi
Workbooks.Open dosya
Application.DisplayAlerts = False
Call kayitoku
Workbooks(Dir(dosya)).Close
Application.DisplayAlerts = True
Windows(1).Activate
End If
Next

End Sub

Bu kodla C:\excel klasörü içindeki dosyaları okuyor fakat yazmıyor tamamın okuyup bitiriyor yardımlarınızı bekliyorum

 

[aligunes]

sayın levetm bu konuya çözüm bulabilir misiniz teşekkürler.