• Merhaba Ziyaretçi,
    Microsoft 365 Uygulamaları ile ilgili yeni haberler, dikkat çekici konular, ilgi ile takip edeceğiniz yazılar için.

    Abone Olun
  • ESTE - Microsoft Office Eğitimleri

    Yeni yıl Microsoft Office Eğitim planlarınız için bütçenizi oluşturmadan önce ESTE eğitim kalitesi ile tanışın. 🙌
    Kullanıcıların ihtiyacı olan yazılı materyal, dosya ve video kaynağı desteğimiz ile tüm ofis çalışanlarının iş süreçlerini rahatlatacak eğitimler planlayın. 🎯
    Microsoft Office eğitimlerimiz hakkında detaylı bilgi için bize ulaşın.

    👉 Microsoft Office Eğitim Talebi

Çözüldü excel de ayrı ayrı dosyalardaki tabloları başka bir excel dosyasında özetleme

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

jäger

Yeni Üye
Katılım
1 Ağu 2018
Mesajlar
15
En iyi yanıt
0
Puanları
1
Yaş
25
Konum
Türkiye
Ad Soyad
Sezer Ulusoy
Merhabalar ,Benim sorum, 3 ayri excel dosyasinda bulunan tablolari ayri bir excel dosyasinin bir sayfasinda hepsini nasil gösterebilirim.

yardimlariniz icin simdiden tesekkurler
 

Ekli dosyalar

  • YYMMDD_Einzelmengenplanung_T1Name_Z1.xlsx
    10.9 KB · Görüntüleme: 7
  • YYMMDD_Einzelmengenplanung_T1Name_Z2.xlsx
    10.9 KB · Görüntüleme: 7
  • YYMMDD_Einzelmengenplanung_T1Name_Z3.xlsx
    10.9 KB · Görüntüleme: 6
  • özet.xlsx
    7.8 KB · Görüntüleme: 8

jäger

Yeni Üye
Katılım
1 Ağu 2018
Mesajlar
15
En iyi yanıt
0
Puanları
1
Yaş
25
Konum
Türkiye
Ad Soyad
Sezer Ulusoy
örnegin seklinde yeni excel tablolari olustugu sürece özet adindaki excel dosyama eklensin...simdiden tesekkürler yardimlariniz icin;
1535967247660.png
 

Murat OSMA

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,506
En iyi yanıt
13
Puanları
113
Konum
İstanbul
Web sitesi
excelarsivi.com
Ad Soyad
Murat OSMA
Office Vers.
Office 365 TR+EN
Merhaba,
Bu kodları kullanabilirsiniz..
PHP:
Sub ExcelTurkey()
    Dim fso As Object, ac As Workbook, sat&, sut&, son&
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False
    For Each dosya In fso.getfolder(ThisWorkbook.Path).Files
        If InStr(1, dosya.Name, "$") = 0 And dosya.Name <> ThisWorkbook.Name Then
            Set ac = Workbooks.Open(dosya)
            With ac.Sheets(1)
                sat = .Cells.SpecialCells(11).Row
                sut = .Cells.SpecialCells(11).Column
                son = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(3).Row
                .Range(.Cells(1, 1), .Cells(sat, sut)).Copy _
                ThisWorkbook.Worksheets(1).Cells(son, "A")
                ac.Close False
            End With
        End If
    Next dosya
    MsgBox "İşlem Tamamlandı.", vbInformation, "Www.ExcelTurkey.Com"
    Application.ScreenUpdating = True
    son = Empty: sut = Empty: sat = Empty: Set ac = Nothing: Set fso = Nothing
End Sub
 

jäger

Yeni Üye
Katılım
1 Ağu 2018
Mesajlar
15
En iyi yanıt
0
Puanları
1
Yaş
25
Konum
Türkiye
Ad Soyad
Sezer Ulusoy
Cok tesekkur ederim yardiminiz icin..
Birsey dikkatimi cekti ,son dosyayi tamamen dogru bir sekilde kopyalarken onceki dosyalarin son satirlarini kopyalamiyor.acaba bu sorunu giderebilirmiyiz???
 

jäger

Yeni Üye
Katılım
1 Ağu 2018
Mesajlar
15
En iyi yanıt
0
Puanları
1
Yaş
25
Konum
Türkiye
Ad Soyad
Sezer Ulusoy
Daha dogrusu ikinci dosyadaki bilgileri,birinci dosyanin icerisinde bilgi olan son satirindan itibaren kopyaliyor.dolayisiyla birinci dosyanin son satirindaki bilgiler gösterilemiyor.bu sorunu giderebilir miyiz?

Tesekkürler
 

Murat OSMA

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,506
En iyi yanıt
13
Puanları
113
Konum
İstanbul
Web sitesi
excelarsivi.com
Ad Soyad
Murat OSMA
Office Vers.
Office 365 TR+EN
Merhaba,
Kodlara bu satırı ilave ettim.
PHP:
If son > 1 Then son = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(3).Row + 2

Tüm kodları buradan kopyalayabilirsiniz..
PHP:
Sub ExcelTurkey()
    Dim fso As Object, ac As Workbook, sat&, sut&, son&
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False
    For Each dosya In fso.getfolder(ThisWorkbook.Path).Files
        If InStr(1, dosya.Name, "$") = 0 And dosya.Name <> ThisWorkbook.Name Then
            Set ac = Workbooks.Open(dosya)
            With ac.Sheets(1)
                sat = .Cells.SpecialCells(11).Row
                sut = .Cells.SpecialCells(11).Column
                son = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(3).Row
                If son > 1 Then son = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(3).Row + 2
                .Range(.Cells(1, 1), .Cells(sat, sut)).Copy _
                ThisWorkbook.Worksheets(1).Cells(son, "A")
                ac.Close False
            End With
        End If
    Next dosya
    MsgBox "İşlem Tamamlandı.", vbInformation, "Www.ExcelTurkey.Com"
    Application.ScreenUpdating = True
    son = Empty: sut = Empty: sat = Empty: Set ac = Nothing: Set fso = Nothing
End Sub
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Üst Alt