dosya birleştirme

[aligunes80]

55-60 civarında excel dosyam var (Birim) Klasörü içerisinde bu dosyaların içerigi hepsinde aynı A Sutun sicil B sutun isimsoyisim C Sutun Miktar D Sutun Açıklama E sutun Birim Adı Dosyaların isimleri ise birimadını içeriyor Burada dosyadaki Kişi sayısı degişken an az 5 en fazla 500 personeli olan şubeler var makro ile bu dosyaları nasıl birleştirebiliriz Birleştirme dosyasına dosyalardaki bilgileri sırasıyla peşpeşe birleştirecek ve tek liste elde edilecek biraz zor soru oldu ama bunu yapabilecek çok arkadaş olduğunu biliyorum bu formda tşk.

 

[Kemal Demir]

Sn.aligunes,

Ek'teki Ornegi inceleyiniz.

Zannedersem istegınızı karsılayacaktır.

NOT:Tum dosyaların formatları aynı sayıldı ve tum dosyaların acılıs sheetleri baz alınmıstır.

 

[Haluk]

Aslında bu iş için VBA kodu yazmanıza veya aramanıza gerek yok.

Hele bir de, bahsettiğiniz gibi sayfa yapıları aynı ise o zaman Excel'in menüleri ile kapalı dosyalardan verileri aktif çalışma sayfasına kolaylıkla aktarabilirsiniz.

Data >> Get External Data >> New Database Querry

Burada, Excel dosya biçimini seçip onaylayın. Çıkan pencerede, kaynak dosyayı seçin... aktif sayfada istediğiniz yere dataları alın.

Dosya sayınız biraz fazla gibi ama olsun, nasıl olsa her gün yapmıyorsunuzdur.

Yoksa, kapalı dosyadan VBA ile veri almanın bir sürü yolu var.

 

[aligunes80]

Sayın kemaldemir

4 satıra kadar olan dosyayı birleştirilen dosyaya yazmıyor
kodda hangi düzeltmeyi yapmam gerekiyor

Selection.Delete
dosya1 = TextBox1
Set yol = CreateObject("Scripting.FileSystemObject").GetFolder(dosya1).Files
For Each dosya In yol
a = a + 1
ListBox1.AddItem dosya.Name

Next
[a1].Select
TextBox2.Text = ListBox1.ListCount


End Sub

Private Sub CommandButton2_Click()
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
klasor = TextBox1
sayi = TextBox2 * 1 - 1
For x = 0 To sayi
dosya = ListBox1.List(x)
Workbooks.Open FileName:=klasor & dosya
Selection.CurrentRegion.Select
Selection.Copy
Windows("ornek.xls").Activate
satir = WorksheetFunction.CountA(ActiveSheet.Range("a1:a65536")) + 1
Cells(satir, 1).Select
Cells(satir, 1).PasteSpecial
Windows(dosya).Activate
ActiveWindow.Close
Next
End Sub

Private Sub UserForm_Click()

End Sub

 

[Kemal Demir]

Sn aligunes Ek'teki dosyayı test ettim(kanımca) problem cıkmadı.

Hata'yı tam olrak anlayamadım tam nedemek istediniz.

Şunu öğrenmek istiyorum,

1.)Listbox'a ilgili Dosyaları atıyormu? Eğer atıyor ıse Editor içerisinden adım adım(f8) ile ilerleyiniz

Sorunu tam olarak belirtirmisiniz?

Private Sub CommandButton1_Click()
On Error Resume Next
Cells.Select
Selection.Delete
dosya1 = TextBox1
Set yol = CreateObject("Scripting.FileSystemObject").GetFolder(dosya1).Files
For Each dosya In yol
c = c + 1
ListBox1.AddItem dosya.Name

Next
[a1].Select
TextBox2.Text = ListBox1.ListCount


End Sub

Private Sub CommandButton2_Click()
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
klasor = TextBox1
sayi = TextBox2 * 1 - 1
For x = 0 To sayi
dosya = ListBox1.List(x)
Workbooks.Open Filename:=klasor & dosya
     Selection.CurrentRegion.Select
    Selection.Copy
    Windows("ornek.xls").Activate
    satir = WorksheetFunction.CountA(ActiveSheet.Range("a1:a65536")) + 1
    Cells(satir, 1).Select
    Cells(satir, 1).PasteSpecial
    Windows(dosya).Activate
    ActiveWindow.Close
Next
End Sub

 

[aligunes80]

cevap

birleştirme yaptığı dosyalardan 5 sıradan az personel içeriyorsa ör: birima dosyasında 3 personel var yani 3 satır dolu bunu birleştirmiyor

 

[excelman]

Workbooks.Open Filename:=klasor & dosya
[/code]

olan yeri aşağıdaki gibi düzeltiniz.


Workbooks.Open Filename:=klasor & "/" dosya

 

[aligunes80]

hata veriyor

Workbooks.Open Filename:=klasor & "/" dosya

bu şekilde düzelttim hata veriyor