80 adet dosyayı tek dosyada makro ile birleştirme

[musculus]

Sub Makro1()
For a = 1 To 2
Workbooks.Open Filename:="C:\" & a
Range("a1:f" & [a65535].End(3).Row).Select
Selection.Copy
MsgBox a
Windows("TÜMHASTA.xls").Activate
Range("a" & [a65536].End(3).Row + 1).Select
ActiveSheet.Paste
Windows(a).Activate
MsgBox a
ActiveWorkbook.Close

Next a
End Sub


A-F aralığında veri olan 80 adet dosyam var.Bu dosyalardaki veri miktarları değişken ama aralık sabit.Tüm hastalar dosyasına bu verileri aktarmak istiyorum her ay veriler değişebildiği için tek tek kopyala yapıştır yapmak istemiyorum.
Dosyaları c dizinine koyacağım ve adları 1-80 arası değişecek kendim yukarıdaki makroyu yazdım ama istediğim şey olmadı
1-Birinci dosya aktarıldıktan sonra "tüm hastalar dosyasını kayıt etmek istiyor musunuz" diye soruyor bu soruyu sormaması mümkün mü ?
evet dersem kayıt edip kapatıyor iptal dersem devam ediyor her dosya için iptal diye tıklamak istemiyorum

2- İkinci dosyayı kopyaladıktan sonra panodaki veriler çok büyük bu bilgileri daha sonra başka programa yapıştırmak istiyormusunuz diye soruyor.

Kısaca tek tıklamayla veriler hiç soru sormadan 80 dosyayı tek dosyaya aktarabilmem mümkün mü ?

 

[uzmanamele]

merhaba

bu işinizi görür mü?

Sub Makro1()
Application.DisplayAlerts = False
'
'
'
Application.DisplayAlerts = True
End Sub

 

[Orion1]

Dosyanız ektedir.

Sub Makro1()
    For a = 1 To 2
    Workbooks.Open Filename:="C:\" & CStr(a) & ".xls"
    Range("a1:f" & [a65535].End(3).Row).Select
    Selection.Copy
    MsgBox a
     Windows("TÜMHASTA.xls").Activate
     Range("a" & [a65536].End(3).Row + 1).Select
     ActiveSheet.Paste
     Application.CutCopyMode = False
     Windows(CStr(a) & ".xls").Activate
     MsgBox a
   ActiveWorkbook.Close
     
    Next a
    End Sub

 

[musculus]

Sayın uzmanamele
çözüm için teşekkür ederim
sorunum kısmi olarak çözüldü.
artık uyarı vermiyor fakat en son ekranda 1 nolu dosya kalıyor ve TÜM hastalar dosyasını içeriği boş
kodlardan


Sub Makro1()
Application.DisplayAlerts = False
For a = 1 To 2
Workbooks.Open Filename:="C:\" & a
Range("a1:f" & [a65535].End(3).Row).Select
Selection.Copy

Windows("TÜMHASTA.xls").Activate
Range("a" & [a65536].End(3).Row + 1).Select
ActiveSheet.Paste
Windows(a).Activate

ActiveWorkbook.Close

Next a
Application.DisplayAlerts = True
End Sub

kırmızı olan kısmı çıkardığımda TÜMHASTA dosya içeriği istediğim gibi oluyor ama ekranda bir sürü açık excel dosyası olacak
nerede hata yapıyorum ?

 

[Orion1]

Benim 3 numaralı mesajda verdiğim kodlar sorunsuz çalışıyor.

 

[musculus]

Sayın Evren Gizlen ve sayın Uzmanamele yardımlarnız için teşekkür ederim
Sayın Evren Gizlenin yöntemi işimi gördü ilginize teşekkür ederim

 

[musculus]

Benim 3 numaralı mesajda verdiğim kodlar sorunsuz çalışıyor.

Bilginize sağlık

 

[Orion1]

Bilginize sağlık

Rica ederim.

 

[yolacim]

harikasınız emeğinize sağlık Allah razı olsun .

 

[sadece_erhan]

Merhaba, burda ismi 1-86 arası olan .xls uzantılı dosyaları birleştirmiş, ben klasördeki bütün .xlsx uzantılı dosyaları birleştirmek istesem nasıl yaparım? daha doğrusu

klasördeki bütün xlsx uzantılı dosyaların a ve j sütünlarını tekbir dosyada birleştirmek istiyorum. bütün çalışma kitapları tek sayfalı ve veriler a3 hücrelerinden başlıyor, dolu olan satır sayıları farklı. (farkedermi bilmiyorum ama hepsinde birleştirilmiş hücreler var) biçimler korunması gerekiyor..

edit: dosyaların bir çoğunda gizlenmiş sayfalar varmış. ama vernin alınacağı sayfa vba da "sayfa1(günlük)" d,ye yazıyor.