• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

birden fazla exceldeki verileri tek bir excel dosyasında toplama

Bir sorum daha olacaktı:
Worksheets(ActiveSheet.Name).Cells(sat, "a") = Dosya

Kodunu uygulayınca örnek dosyaların isimleri sadece 3. ve 5. satır A hücresinde gözüküyor. Bunu değer olan satırlarda gösterebilirmiyiz?
 
Aynı zamanda deneme dosyasında (verilerin çekileceği dosyada) veriler 2. satırdan itibaren yazdırılıyor. Bu 2. satırdan yazdırmaya başlama kodu hangisidir acaba? Kısaca 2. satır yerine mesela 10. satırdan yazdırma kodu nasıldır acaba?
 
betoncu' Alıntı:
Bir sorum daha olacaktı:
Worksheets(ActiveSheet.Name).Cells(sat, "a") = Dosya

Kodunu uygulayınca örnek dosyaların isimleri sadece 3. ve 5. satır A hücresinde gözüküyor. Bunu değer olan satırlarda gösterebilirmiyiz?
Genişletmek için tıkla ...
Kodları Şu şekilde denermisiniz

Worksheets(ActiveSheet.Name).Cells(sat, "b") = ExecuteExcel4Macro(deg & 3 & "C" & 3)
Worksheets(ActiveSheet.Name).Cells(sat, "c") = ExecuteExcel4Macro(deg & 3 & "C" & 4)
Worksheets(ActiveSheet.Name).Cells(sat, "d") = ExecuteExcel4Macro(deg & 3 & "C" & 5)
Worksheets(ActiveSheet.Name).Cells(sat, "e") = ExecuteExcel4Macro(deg & 3 & "C" & 6)
Worksheets(ActiveSheet.Name).Cells(sat, "a") = Dosya
sat = sat + 1
Worksheets(ActiveSheet.Name).Cells(sat, "b") = ExecuteExcel4Macro(deg & 4 & "C" & 3)
Worksheets(ActiveSheet.Name).Cells(sat, "c") = ExecuteExcel4Macro(deg & 4 & "C" & 4)
Worksheets(ActiveSheet.Name).Cells(sat, "d") = ExecuteExcel4Macro(deg & 4 & "C" & 5)
Worksheets(ActiveSheet.Name).Cells(sat, "e") = ExecuteExcel4Macro(deg & 4 & "C" & 6)
Worksheets(ActiveSheet.Name).Cells(sat, "a") = Dosya
Genişletmek için tıkla ...
Diğer sorunuzun cevabına gelince kodların gerçek sahibi Halit hocam umarım cevap verir
 
Numan bey çok teşekkür ederim. Açıklamalarınız çok faydalı oldu.
Halit hocamdanda yardım bekliyoruz. Emeklerinize sağlık...
 
betoncu' Alıntı:
Aynı zamanda deneme dosyasında (verilerin çekileceği dosyada) veriler 2. satırdan itibaren yazdırılıyor. Bu 2. satırdan yazdırmaya başlama kodu hangisidir acaba? Kısaca 2. satır yerine mesela 10. satırdan yazdırma kodu nasıldır acaba?
Genişletmek için tıkla ...

Başlangıç satırı kodun bu bölümü:

Kod: 
sat = Cells(Rows.Count, "d").End(3).Row + [COLOR=red]1[/COLOR]

Kırmızı yerin değerini arttırırsanız o kadar satırdan sonra veriler yazılacaktır.
 
halit3' Alıntı:
Başlangıç satırı kodun bu bölümü:

Kod: 
sat = Cells(Rows.Count, "d").End(3).Row + [COLOR=red]1[/COLOR]

Kırmızı yerin değerini arttırırsanız o kadar satırdan sonra veriler yazılacaktır.
Genişletmek için tıkla ...

Halit bey kırmızı 1 yerine 9 koyunca örnek1 e ait veriler 10. satırdan başladı fakat bu sefer örnek 2 ye ait veriler 20. satırdan itibaren yazılmaya başlandı.
Örnek2 ye ait veriler örnek1in bittiği son satırdan hemen sonra nasıl başlatılır acaba?

Kodun İlgili Kısmı:
sat = Cells(Rows.Count, "d").End(3).Row + 9
sayfaadi = "Sayfa1"
'Cells(sat, "A").Value = Klasor & "\" & Dosya
deg = "'" & Klasor & "\[" & Dosya & "]" & sayfaadi & "'!R"

Worksheets(ActiveSheet.Name).Cells(sat, "b") = ExecuteExcel4Macro(deg & 3 & "C" & 3)
Worksheets(ActiveSheet.Name).Cells(sat, "c") = ExecuteExcel4Macro(deg & 3 & "C" & 4)
Worksheets(ActiveSheet.Name).Cells(sat, "d") = ExecuteExcel4Macro(deg & 3 & "C" & 5)
Worksheets(ActiveSheet.Name).Cells(sat, "e") = ExecuteExcel4Macro(deg & 3 & "C" & 6)
Worksheets(ActiveSheet.Name).Cells(sat, "a") = Dosya
sat = sat + 1
Worksheets(ActiveSheet.Name).Cells(sat, "b") = ExecuteExcel4Macro(deg & 4 & "C" & 3)
Worksheets(ActiveSheet.Name).Cells(sat, "c") = ExecuteExcel4Macro(deg & 4 & "C" & 4)
Worksheets(ActiveSheet.Name).Cells(sat, "d") = ExecuteExcel4Macro(deg & 4 & "C" & 5)
Worksheets(ActiveSheet.Name).Cells(sat, "e") = ExecuteExcel4Macro(deg & 4 & "C" & 6)
Worksheets(ActiveSheet.Name).Cells(sat, "a") = Dosya
 
betoncu' Alıntı:
Halit bey kırmızı 1 yerine 9 koyunca örnek1 e ait veriler 10. satırdan başladı fakat bu sefer örnek 2 ye ait veriler 20. satırdan itibaren yazılmaya başlandı.
Örnek2 ye ait veriler örnek1in bittiği son satırdan hemen sonra nasıl başlatılır acaba?

Kodun İlgili Kısmı:
sat = Cells(Rows.Count, "d").End(3).Row + 9
sayfaadi = "Sayfa1"
'Cells(sat, "A").Value = Klasor & "\" & Dosya
deg = "'" & Klasor & "\[" & Dosya & "]" & sayfaadi & "'!R"

Worksheets(ActiveSheet.Name).Cells(sat, "b") = ExecuteExcel4Macro(deg & 3 & "C" & 3)
Worksheets(ActiveSheet.Name).Cells(sat, "c") = ExecuteExcel4Macro(deg & 3 & "C" & 4)
Worksheets(ActiveSheet.Name).Cells(sat, "d") = ExecuteExcel4Macro(deg & 3 & "C" & 5)
Worksheets(ActiveSheet.Name).Cells(sat, "e") = ExecuteExcel4Macro(deg & 3 & "C" & 6)
Worksheets(ActiveSheet.Name).Cells(sat, "a") = Dosya
sat = sat + 1
Worksheets(ActiveSheet.Name).Cells(sat, "b") = ExecuteExcel4Macro(deg & 4 & "C" & 3)
Worksheets(ActiveSheet.Name).Cells(sat, "c") = ExecuteExcel4Macro(deg & 4 & "C" & 4)
Worksheets(ActiveSheet.Name).Cells(sat, "d") = ExecuteExcel4Macro(deg & 4 & "C" & 5)
Worksheets(ActiveSheet.Name).Cells(sat, "e") = ExecuteExcel4Macro(deg & 4 & "C" & 6)
Worksheets(ActiveSheet.Name).Cells(sat, "a") = Dosya
Genişletmek için tıkla ...

Yukarıdaki mesajımda söylemiştim ben dosyanıza vakıf değilim.İşlemleri bilmek dosyanıza hakim olmak anlamına gelmesin bu konular baya zahmetli ve meşakkat isteyen konular.

Başka mesaj yazmıyacağım.

kod:

Kod: 
Dim sat As String
Private Sub CommandButton1_Click()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
[A2:I65000] = ""
sat = 9
Liste (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Liste(yol As String)
Dim fL As Object, fs As Object, f As Object, j As Long, n As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(yol).subfolders
Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(yol).Files
If Right(yol, 1) <> "\" Then ekle = "\"
On Error Resume Next
For Each Dosya In fs
Application.DisplayAlerts = False
If ThisWorkbook.Name <> Dosya Then
sayfaadi = "Sayfa1"
deg = "'" & yol & ekle & "[" & Dosya.Name & "]" & sayfaadi & "'!R"
If ExecuteExcel4Macro(deg & 3 & "C" & 3) <> "" Then
Worksheets(ActiveSheet.Name).Cells(sat, "a") = Dosya.Name
Worksheets(ActiveSheet.Name).Cells(sat, "b") = ExecuteExcel4Macro(deg & 3 & "C" & 3)
Worksheets(ActiveSheet.Name).Cells(sat, "c") = ExecuteExcel4Macro(deg & 3 & "C" & 4)
Worksheets(ActiveSheet.Name).Cells(sat, "d") = ExecuteExcel4Macro(deg & 3 & "C" & 5)
Worksheets(ActiveSheet.Name).Cells(sat, "e") = ExecuteExcel4Macro(deg & 3 & "C" & 6)
sat = Cells(Rows.Count, "b").End(3).Row + 1
End If
If ExecuteExcel4Macro(deg & 4 & "C" & 3) <> "" Then
Worksheets(ActiveSheet.Name).Cells(sat, "f") = ExecuteExcel4Macro(deg & 4 & "C" & 3)
Worksheets(ActiveSheet.Name).Cells(sat, "g") = ExecuteExcel4Macro(deg & 4 & "C" & 4)
Worksheets(ActiveSheet.Name).Cells(sat, "h") = ExecuteExcel4Macro(deg & 4 & "C" & 5)
Worksheets(ActiveSheet.Name).Cells(sat, "ı") = ExecuteExcel4Macro(deg & 4 & "C" & 6)
Worksheets(ActiveSheet.Name).Cells(sat, "a") = Dosya.Name
sat = Cells(Rows.Count, "f").End(3).Row + 1
End If
End If

Next
On Error GoTo sonraki
For Each f In fL
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub
 
Halit bey çok teşekkür ederim. Sizin ve diğer arkadaşların sayesinde faydalı bilgiler edindim:)
 
Halit hocam Müsadenizle
kodlarda ufak bir değişiklik yaptım
 

Ekli dosyalar

merhaba,

elimde anket için hazırlanmış standart bir form var. Yapmak istediğim şey bu excellerden verileri çekip bi rapor hazırlamak istiyorum. yukarıdaki cevaplardan uğraştım ama çözemedim.. şimdiden yardımlarınız için çok teşekkür ederim






numan şamil' Alıntı:
merhaba
Bütün dosyalarda veri çekeceğiniz hücreler standart ise ve veri çekilecek dosyalar ile veriyi aktaracağınız dosya ayrı klosörde olmalıdır

ekteki dosyayı inceleyiniz veri çekeceğiniz hücrelere göre uyarlamaya çalışınız
Aktar butonuna basınız
Genişletmek için tıkla ...
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst