Hücredeki dosya isimlerine göre atlamalı dosyadan veri alma (açarak)

[netkit]

Hayırlı sahurlar;

Ekteki dosyada yapmak istediğim;

a1 deki dosyayı açıp sonra a2 deki dosyayı açıp A:F kolonunu a1 deki dosyaya kaydedip a2 yi kapatıp a3 e geçerek a10 a gelince boşluğu görünce a1 deki dosyanın adını değiştirip
a11 den devam etmesi. Fakat döngüyü bir türlü kuramadım.
a1 i açınca a2 yi açıp kapattıktan sonra a3 açarken döngüyü döndüremiyorum.(modul12)
Gene forumdan sağolsun Sayın Halit3, Sayın ömerceri nin kodlarından oluşturmaya çalıştığım modul 4 de

If FSO.FileExists(dosya) = False Then satırında object variable or with block variable set hatası veriyor.

bu konuda nasıl bir yol izemem gerekiyor acaba?

 

[bedersu]

Sayın netkit,
Ekteki dosyada module12'de "ERD MAKRO_isimler 1.xls" isimli bir dosya var.Bu dosyanın sorunuzla olan ilgisini anlayamadım.A1 hücresindeki kitabın açılması gerekmiyor muydu?Benim sorunuzdan anladığım şu şekilde:

A1 hücresindeki ve A2 hücresindeki kitaplar açılacak.A2 hücresindeki kitabın A:F sütunları kopyalanıp A1 hücresinde ismi geçen kitabın A sütununa kopyalanacak.A2'de ismi geçen kitap kapatılıp A3'teki kitap açılacak.Aynı işlem buna da yapılacak.Bu veriler daha önce kopyalanan verilerin devamına yapıştırılacak.En son A9'da ismi geçen dosyadan da veriler alınıp kopyalandıktan sonra boş hücreyi görünce A1 'de ismi geçen dosya kaydedilecek ve A1 hücresine farklı bir isim yazılacak.Doğru mudur?

Peki bu işlem sonunda A1'de ismi geçen dosya farklı mı kaydedilecek?A11'den devam edilirken de mi A11'deki dosyaya diğer 8 dosyanın A:F sütunlarından alınan veriler A11'deki dosyaya kaydedilecek?
Bunları açıklarsanız yardımcı olabiliriz İnşallah.

Diğer sorunuza gelince.Hata FileSystemObject'ten kaynaklanıyor.Module4'te "dim" lerin üstüne aşağıdaki satırı yapıştırın.Çünkü "FileExists" bir FileSystemObject üyesidir.


Set FSO = CreateObject("Scripting.FileSystemObject")

 

[netkit]

Sayın bedersu;
amacım sizinde dediğinizi gibi.
aynı isimli farklı dönemli dosyaları tek dosyada toplamak.
a1 ile a9 arası aynı firmanın farklı döenmleri hepsini bir dosyada toplayıp full diye kaydedip
a11 den devam etmek istiyorum.. "ERD MAKRO_isimler 1.xls" dosyanın ilk hali foruma gönderirken farklı kaydedip gönderince acemilik onu MAKRO_isimler olarak değiştirmeyi unutmuşum. buradan amacım bu kitabı aktif edip dosya isimlerini okutmak içindi.

Set FSO = CreateObject("Scripting.FileSystemObject") için teşekkür ederim.

 

[bedersu]

Sayın netkit,
Şu kodlar işinize yarar sanırım.Fakat çok sayıda dosya olduğu için biraz kasabilir.Dosya yollarını kendinize göre düzenleyin.


Sub ac_kaydet()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
a = 0
basla:
a = a + i + 1
For ii = 1 To 3660 Step 10
anadosya = Cells(ii, 1)
Workbooks.Open ("C:\Users\bedersu\Downloads\deneme\") & anadosya

For i = 2 To 3660
ActiveWindow.ActivateNext

dosya = Cells(i, 1)
If dosya = "" Then GoTo kayit:

Workbooks.Open ("C:\Users\bedersu\Downloads\deneme\") & dosya
Range("A1:F9").Select
Selection.Copy
dvm = dvm + 1

Workbooks(anadosya).Activate
hcr = WorksheetFunction.CountA(Range("A:A"))
Range("A" & hcr + 1 & ":F" & hcr + 1).Select
Selection.Insert Shift:=xlToRight

Workbooks(dosya).Activate
ActiveWorkbook.Close
' Workbooks(anadosya).Activate
'ActiveWindow.ActivateNext

'Cells(hcr + 1, 1).Paste
Next
kayit:
Workbooks("DENEME.xlsm").Activate ' Workbooks("MAKRO_isimler.xls")olacak

a = Len(Cells(1, 1))
x = 1
Do Until Right(Left(Cells(1, 1), x), 1) = " "
x = x + 1

Loop

aaa = Left(Cells(1, 1), x - 1)

Workbooks(anadosya).Activate


ActiveWorkbook.SaveAs Filename:= _
"C:\Users\bedersu\" & aaa & " Full.xls"

ActiveWorkbook.Close
Next


Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub