• DİKKAT

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

klasörün içindeki çalışma sayfalarının herbirindeki bir sekmeyi tek çalışma sayfasında gösterme

M

modoste

Altın Üye
Katılım
31 Mayıs 2008
Mesajlar
3,714
Excel Vers. ve Dili
Microsoft OFFİCE Ev ve İş 2019 TR
merhaba sayın hocalarım
şu anda işyerinde muhasebeci arkadaşın bir çalışması oldu ve ben yardım ettim ancak çok uzun yolla hallettim bu konuda yardım gerekmekte
durum şu
bilgisayarımın Data (D:) sürücüsünde DOSYALARIM klasöründe PERSONEL klasörünün içinde (Ali Durmaz, Selim Açıcı, Onur Göl,....) gibi çalışma sayfaları mevcut ve herbirinde "Jandarma" adlı sekmede bir tablo var.

istediğim ise RAPOR adlı yeni bir excel çalışma sayfasında ilk sekmede Ali Durmaz Yazcak yanındaki sekmede Selim Açıcı yazcak.... ve Jandarma sekmesindeki tablolar buraya gelecek)
 
Merhaba,

Klasör, çalışma sayfası, sekmelerden hiç bir şey anlamadım. Dosya adı ile çalışma sayfasını, sayfalar ile sekmeleri karıştırmışsınız.
Ne demek istediğiniz tam olarak anlaşılmıyor.

Siz en iyisi basit bir örnek dosya(lar) ekleyin, sorunuzu açıklayın.
 
Necdet' Alıntı:
Merhaba,

Klasör, çalışma sayfası, sekmelerden hiç bir şey anlamadım. Dosya adı ile çalışma sayfasını, sayfalar ile sekmeleri karıştırmışsınız.
Ne demek istediğiniz tam olarak anlaşılmıyor.

Siz en iyisi basit bir örnek dosya(lar) ekleyin, sorunuzu açıklayın.
Genişletmek için tıkla ...
+1
(y)
 
ifadeleri söyle değişeyim
bir klasörüm var ve içinde personel adlarıyla excel dosyalarım var (Ali durmaz,Selim Açıcı,......) ve hepsinde "Jandarma" adlı sekmede tablo var
bu klasör içine "RAPOR" isimli yeni bir excel dosyası var. bu dosyada olmasını istediğim şey ise sekmelerin adı ali durmaz,selim açıcı.. diye oluşacak ve tablolar burda gözükecek

kısaca birden fazla dosyadaki aynı sekmeyi bir dosya içinde göstermek
 
Bu kod klasörün içindeki excell dosyalarının birinci sayfasını aktif dosyaya sekme olarak kopyalıyor.

Kod: 
Dim Sayfa_Adı As String
Dim dosya_adı As String

Sub deneme()
dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name
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
Application.ScreenUpdating = False
Liste4 (Kaynak)
Sheets(Sayfa_Adı).Select
ActiveWindow.WindowState = xlMaximized
MsgBox "işlem tamam"
Else
atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set obj = Nothing
Set Klasor = Nothing
End Sub


Private Sub Liste4(yol As String)

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
Dim wb As Workbook
For Each dosya In fL.getfolder(yol).Files
If ThisWorkbook.Name <> dosya Then
Set wb = Workbooks.Open(dosya)

Application.DisplayAlerts = False
son = Workbooks(dosya_adı).Sheets.Count
ActiveWorkbook.Worksheets("jandarma").Copy Before:=Workbooks(dosya_adı).Sheets(1)
Workbooks(dosya_adı).Sheets(1).Move After:=Sheets(son + 1)

wb.Close False
End If
Next
On Error GoTo sonraki
For Each f In fL.getfolder(yol).SubFolders
Liste4 (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub
 
Son düzenleme:
sayın halit hocam
klasörün içindeki excel dosyalarının birinci sayfası değil "Jandarma" yazan sayfayı alması gerekiyor. kodda değiştirilebilecek kısımları kırmızı renkte yapabilir misiniz hocam
 
bu bölümü
Kod: 
ActiveWorkbook.Worksheets(1).Select

bununla değiştir.

Kod: 
ActiveWorkbook.Worksheets("jandarma").Select
 
5 nolu mesajdaki kodu güncelledim.
 
teşekkür ederim hocam.
deneme yaptım ama bi hata oldu basit olsun diye 4 excel dosyası yaptım makroyu çalıştırdığımda jandarma, jandarma(1),jandarma(2) ve jandarma(3) sekmeleri oluştu ama bu sekmelerin isimleri hangi isimli dosyadan aldıysam o dosyanın adı olmalıydı

yaptıklarımı tekrar kısaca anlatırsam
masaüstünde "Yeni Klasör" isimli dosya içine 3 adet excel dosyası oluşturdum. Ali Gel, Veli Git, ve Osman Ak adıyla 3 excel dosyası
herbir excel dosyasının ilk sekmesini "jandarma" adı verdim ve basit bir tablo yaptım
daha sonra masaüstünde yeni bir excel dosyası adı (rapor) oluşturdum ve sayfa 1 sekmesine makroyu ekledim. çalıştırdığımda küçük bi pencere açıldı klasör adını sordu "Yeni Klasör" ü seçtim çalıştırdı 3 excel dosyasındaki tabloları jandarma,jandarma(1),jandarma(2) gibi sekmede gösterdi. hatalı olan sadece jandarma=Ali Gel
jandarma(1)=Veli Git
jandarma(2)=Osman Ak sekme adı olarak değişmesiydi.
 
Son düzenleme:
bunu bir dene

Rich (BB code): 
Dim Sayfa_Adı As String
Dim dosya_adı As String

Sub deneme()
dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name
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
Application.ScreenUpdating = False
Liste4 (Kaynak)
Sheets(Sayfa_Adı).Select
ActiveWindow.WindowState = xlMaximized
MsgBox "işlem tamam"
Else
atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set obj = Nothing
Set Klasor = Nothing
End Sub


Private Sub Liste4(yol As String)

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
Dim wb As Workbook
For Each dosya In fL.getfolder(yol).Files

If ThisWorkbook.Name <> dosya Then
Set wb = Workbooks.Open(dosya)

Application.DisplayAlerts = False
son = Workbooks(dosya_adı).Sheets.Count
ActiveWorkbook.Worksheets("jandarma").Copy After:=Workbooks(dosya_adı).Sheets(son)
Workbooks(dosya_adı).Sheets(ActiveSheet.Name).Name = fL.GetBaseName(dosya)

wb.Close False
End If
Next
On Error GoTo sonraki
For Each f In fL.getfolder(yol).SubFolders
Liste4 (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub
 
Son düzenleme:
son gönderdiğinizde çözüme ulaştım sayın halit hocam emeğinize sağlık
 
Teşekkürler iyi çalışmalar
kodu yeniden güncelledim.
 
hocam güncelledim derken değiştirdiğiniz eklediğiniz bir detay mı var
 
sayın hocam peki excel dosyalarından bazılarında "jandarma" sekmesi yok diyelim sadece "jandarma" sekmesi olan dosyalarda işlem yapsa makro nasıl değişir
 
bunu bir dene

Rich (BB code): 
Dim Sayfa_Adı As String
Dim dosya_adı As String

Sub deneme()
dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name
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
Application.ScreenUpdating = False

Liste4 (Kaynak)
Sheets(Sayfa_Adı).Select
ActiveWindow.WindowState = xlMaximized
MsgBox "işlem tamam"
Else
atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set obj = Nothing
Set Klasor = Nothing
End Sub


Private Sub Liste4(yol As String)

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
Dim wb As Workbook
For Each dosya In fL.getfolder(yol).Files

If ThisWorkbook.Name <> dosya Then
Set wb = Workbooks.Open(dosya)
yeni_dosya_adı = ActiveWorkbook.Name

For j = 1 To Workbooks(yeni_dosya_adı).Sheets.Count
If Workbooks(yeni_dosya_adı).Sheets(j).Name = "Jandarma" Then
Application.DisplayAlerts = False
son = Workbooks(dosya_adı).Sheets.Count
Workbooks(yeni_dosya_adı).Worksheets(j).Copy After:=Workbooks(dosya_adı).Sheets(son)
ThisWorkbook.Sheets(ActiveSheet.Name).Name = fL.GetBaseName(dosya)
End If
Next

wb.Close False
End If
Next
On Error GoTo sonraki
For Each f In fL.getfolder(yol).SubFolders
Liste4 (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub
 
uyguladım oldu hocam son çözümünüzde bugün öğle saatlerinde bilmediğimizden yaklaşık 50 adet sekmeyi taşı/kopyala/sona taşı işleriyle uğraştık
bundan sonra çözümü öğrenmiş olduk.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst