Kapalı Dosyalardan Verileri Toplayarak Almak

[htsumer]

Merhaba arkadaşlar,Pazartesi görev icabı başka yere gideceğimden bu dosyanın acil bu gece bitmesi gerek.Benim ise makroları araştırıp hazırlamaya hiç vaktim yok (*).Bu nedenle sizlerden şöyle bir makro istiyorum.

Kıstaslar.
12 Adet Excel çalışma kitabım var.
12 sinin adı farklı farklı.
12 sinin içindeki verilerin hepsi aynı sütun ve aynı satırda bulunuyor.

12 Dosyadaki Tüm dolu hücreler toplanarak aktarılacak.
Yani 12 Tane A1 Hücresi toplanarak tek Hücrede,12 Tane A2 Hücresi toplanarak tek hücrede.....gibi
Teşekkürler


(*)Diğer işlemleri yapmak zorundayım.

 

[Haluk]

Merhaba arkadaşım;

Aşağıdaki kod ile "C:\Temp\" klasöründe kapalı durumda olan tüm çalışma kitaplarındaki Sheet1 isimli sayfalarında A1:E10 aralığındaki tüm hücreler toplanarak, kodun yazıldığı kitapta yine A1:E10 aralığındaki hücrelere yazılırlar.

Const MyPath As String = "C:\Temp\"
Const MySh As String = "Sheet1"
Dim MyArg As String
'
Sub Test()
    'Raider
    Dim MyFile As String
    Dim i As Long, j As Integer
    Range("A1:E10").ClearContents
    MyFile = Dir(MyPath & Application.PathSeparator & "*.xls", vbDirectory)
    Do While MyFile <> ""
    If MyFile = ThisWorkbook.Name Then GoTo ResumeSub:
    MyArg = "'" & MyPath & "[" & MyFile & "]" & MySh & "'!R"
        For j = 1 To 5
            For i = 1 To 10
                Cells(i, j) = Cells(i, j) + ExecuteExcel4Macro(MyArg & i & "C" & j)
            Next
        Next
ResumeSub:
    MyFile = Dir
    Loop
End Sub

 

[htsumer]

Merhaba Sayın Haluk,
Kodlarınızı ancak deneme fırsatım oldu.Ve şunu söylemek isterim.Beynimi okumuşsunuz..
Teşekkürler.
(Bu arada Hayırlı olsun). k::
Veri alınacak yerlerde metinsel karakterler de bulunduğunu yazmamışım.Ama olsun benim işime gerekli olan sayısal metinler..
A1:E10 aralığınıda kendime göre düzenlerim.
Çok çok teşekkür ederim.Buna benzer bir çalışmanızı Sayın Abazya link olarak vermişti.Fakat uğraşamadım..Onada buradan tekrar teşekkürler..
İyi akşamlar

 

[Haluk]

....
(Bu arada Hayırlı olsun). k::
...

Teşekkürler arkadaşım ...