bir çok excel dosyasındaki aynı hücreleri tek bir excele aktarmak

[finansalhaber]

Arkadaşlar, merhaba,

Bu forumda bir çok sorunuma çözüm buldum, bunun için herkese tekrar tekrar teşekkür etmek istiyorum. Sizlerden yeni bir şey rica edeceğim.

C:\ klaösründe yer alan tüm excel dosyalarından belirli sütünları; alt lata yeni bir excel dosyasına nasıl kaydedebilirm. yarımlarınız için çok teşekkürler.

kısaca anlatmam gerekirse;

C:\ klasöründe 65 adet dosyam var, ve ben bu 65 dosyadaki E17,F17,G17,H17,I17 HÜCRELERİNDEKİ değerleri, Yeni bir excel dosyasına altlata aktarmak istiyorum.

teşekkürler

 

[Korhan Ayhan]

Selamlar,

C klasörü altında "VERİ" isimli bir klasör oluşturun. Bu klasörün içine bahsettiğiniz 65 adet dosyayı yerleştirin. Daha sonra aşağıdaki kodu verileri almak istediğiniz dosya içine boş bir modül ekleyerek uygulayın. Umarım faydası olur.

Sub VERİLERİ_AKTAR()
    Application.ScreenUpdating = False
    Set HEDEF_DOSYA = ActiveWorkbook
    Set HEDEF_SAYFA = HEDEF_DOSYA.Sheets("Sayfa1")
    HEDEF_SAYFA.[A2:A65536].ClearContents
    HEDEF_KLASÖR = "C:\VERİ"
    Set CSFSO = CreateObject("Scripting.FileSystemObject")
    If Not CSFSO.FolderExists(HEDEF_KLASÖR) Then GoTo Son
    If CSFSO.GetFolder("C:\VERİ").Files.Count = 0 Then GoTo Son
    SATIR = 2
    For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder("C:\VERİ").Files
    Workbooks.Open (Dosya)
    Set KAYNAK_DOSYA = ActiveWorkbook
    HEDEF_DOSYA.Activate
    For X = 5 To 9
    If KAYNAK_DOSYA.Sheets(1).Cells(17, X) <> "" Then
    HEDEF_SAYFA.Cells(SATIR, 1) = KAYNAK_DOSYA.Sheets(1).Cells(17, X)
    SATIR = SATIR + 1
    End If
    Next
    KAYNAK_DOSYA.Close False
    Next
    [A1].Select
    Cells.EntireColumn.AutoFit
    Set HEDEF_DOSYA = Nothing
    Set HEDEF_SAYFA = Nothing
    Set KAYNAK_DOSYA = Nothing
    Set CSFSO = Nothing
    Application.ScreenUpdating = True
    MsgBox "VER&#304;LER AKTARILMI&#350;TIR.", vbInformation
    Exit Sub
Son:
    [A1].Select
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
    MsgBox "VER&#304; AKTARILACAK DOSYA YADA KLAS&#214;R BULUNAMAMI&#350;TIR !", vbExclamation, "UYARI !"
End Sub

 

[finansalhaber]

Sayın Cost Control,

Söylediğiniz işlemi yaptım, ancak msgbox ""VERİ AKTARILACAK DOSYA YADA KLASÖR BULUNAMAMIŞTIR " uyarısı veriyor.

c:\VERİ klasöründe dosyalar var ve bu dosyların içinde gerekli bilgiler devar, ancak her zaman bu uyarıyı alıyorum.

yardımcı olabilir misiniz?

teşekkürler

 

[finansalhaber]

sayın Cost Control,

Verdiğiniz kodlar çalıştı, ancak benim c:\VERI klasöründen bir excel dosyasından aldığım E17,F17,G17,H17,I17 veriler yanyana, Diğer bir excel dosyasından aldığım E17,F17,G17,H17,I17 bilgiler bunun altına olcak şekilde yapmam gerekiyor,

yani;

65 dosyadan aldığım E17,F17,G17,H17,I17 bilgiler,65 satırda göstermem gerekiyor. her dosya için E17,F17,G17,H17,I17 bilgileri ise yanyana olması gerekiyor.
Böyle yapmamız mümkün müdür?

Çok teşekkürler

 

[finansalhaber]

belirli hücrelerin tek sayfaya aktarımı hk.

Arkadaşlar,merhaba,

forumda cost_control arkadaşın yardımı ile ekteki dosyayı yapabildim. Kısaca anlatmak gerekirse ;

C:\VERI klasöründe yer alan tüm excel dosylaındaki E17,F17,G17,H17,I17 hücrelerinde yer alan bilgileri örnek isimli dosyadaki a hücresine altlata yazıyor. Ancak benim istediğim bir dosyadan aldığı E17,F17,G17,H17,I17 bilgileri, bizim örnek sayfada A1,B1,C1,D1,E1 hücresine yazması, daha sonra ikinci dosyanın E17,F17,G17,H17,I17 geçtiği zaman A2,B2,C2,D2,E2 olarak devam etmesi.

Yardımcı olursanız çok sevinirim.

Teşekkürler,

 

[finansalhaber]

belirli hücrelerin tek sayfaya aktarımı hk.(ekli dosyalar)

Ekli dosyaları unutmuşum: ) ekledim. tekrar teşekkrüler...

Arkadaşlar,merhaba,

forumda cost_control arkadaşın yardımı ile ekteki dosyayı yapabildim. Kısaca anlatmak gerekirse ;

C:\VERI klasöründe yer alan tüm excel dosylaındaki E17,F17,G17,H17,I17 hücrelerinde yer alan bilgileri örnek isimli dosyadaki a hücresine altlata yazıyor. Ancak benim istediğim bir dosyadan aldığı E17,F17,G17,H17,I17 bilgileri, bizim örnek sayfada A1,B1,C1,D1,E1 hücresine yazması, daha sonra ikinci dosyanın E17,F17,G17,H17,I17 geçtiği zaman A2,B2,C2,D2,E2 olarak devam etmesi.

Yardımcı olursanız çok sevinirim.

Teşekkürler,

 

[finansalhaber]

belirli hücrelerin tek sayfaya aktarımı hk.(ekli dosyalar)

Arkadaşlar,
ekli dosyları ancak gönderebildim. Anlayışınız için teşekkürler,

Arkadaşlar,merhaba,

forumda cost_control arkadaşın yardımı ile ekteki dosyayı yapabildim. Kısaca anlatmak gerekirse ;

C:\VERI klasöründe yer alan tüm excel dosylaındaki E17,F17,G17,H17,I17 hücrelerinde yer alan bilgileri örnek isimli dosyadaki a hücresine altlata yazıyor. Ancak benim istediğim bir dosyadan aldığı E17,F17,G17,H17,I17 bilgileri, bizim örnek sayfada A1,B1,C1,D1,E1 hücresine yazması, daha sonra ikinci dosyanın E17,F17,G17,H17,I17 geçtiği zaman A2,B2,C2,D2,E2 olarak devam etmesi.

Yardımcı olursanız çok sevinirim.

Teşekkürler,

 

[Skorpiyon]

Ekli dosyaları unutmuşum: ) ekledim. tekrar teşekkrüler...

Maalesef dosyayı ekleyememişsiniz...

Saygılarımla...

 

[finansalhaber]

Dosyaları, en son mesajta ekleybildim.
yardımcı olursanız çok sevinirim
tşk

 

[Korhan Ayhan]

Selamlar,

Lütfen aynı soru için birden fazla başlık açmayınız.

 

[Korhan Ayhan]

Selamlar,

Daha önce önermiş olduğum kodu aşağıdaki şekilde değiştirip denermisiniz.

Sub VERİLERİ_AKTAR()
    Application.ScreenUpdating = False
    Set HEDEF_DOSYA = ActiveWorkbook
    Set HEDEF_SAYFA = HEDEF_DOSYA.Sheets("Sayfa1")
    HEDEF_SAYFA.[A2:F65536].ClearContents
    HEDEF_KLASÖR = "C:\VERİ"
    Set CSFSO = CreateObject("Scripting.FileSystemObject")
    If Not CSFSO.FolderExists(HEDEF_KLASÖR) Then GoTo Son
    If CSFSO.GetFolder("C:\VERİ").Files.Count = 0 Then GoTo Son
    SATIR = 2
    SÜTUN = 1
    For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder("C:\VERİ").Files
    Workbooks.Open (Dosya)
    Set KAYNAK_DOSYA = ActiveWorkbook
    HEDEF_DOSYA.Activate
    For X = 5 To 9
    If KAYNAK_DOSYA.Sheets(1).Cells(17, X) <> "" Then
    HEDEF_SAYFA.Cells(SATIR, S&#220;TUN) = KAYNAK_DOSYA.Sheets(1).Cells(17, X)
    S&#220;TUN = S&#220;TUN + 1
    End If
    Next
    KAYNAK_DOSYA.Close False
    SATIR = SATIR + 1
    S&#220;TUN = 1
    Next
    [A1].Select
    Cells.EntireColumn.AutoFit
    Set HEDEF_DOSYA = Nothing
    Set HEDEF_SAYFA = Nothing
    Set KAYNAK_DOSYA = Nothing
    Set CSFSO = Nothing
    Application.ScreenUpdating = True
    MsgBox "VER&#304;LER AKTARILMI&#350;TIR.", vbInformation
    Exit Sub
Son:
    [A1].Select
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
    MsgBox "VER&#304; AKTARILACAK DOSYA YADA KLAS&#214;R BULUNAMAMI&#350;TIR !", vbExclamation, "UYARI !"
End Sub

 

[finansalhaber]

Sayın cost_control çok teşekkür ederim. gerçekten bana çok yardımcı oldunuz