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

modoste

Altın Üye
Katılım
31 Mayıs 2008
Mesajlar
3,598
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)
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,181
Excel Vers. ve Dili
Ofis 365 Türkçe
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.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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.
+1
(y)
 

modoste

Altın Üye
Katılım
31 Mayıs 2008
Mesajlar
3,598
Excel Vers. ve Dili
Microsoft OFFİCE Ev ve İş 2019 TR
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
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,758
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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:

modoste

Altın Üye
Katılım
31 Mayıs 2008
Mesajlar
3,598
Excel Vers. ve Dili
Microsoft OFFİCE Ev ve İş 2019 TR
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
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,758
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
bu bölümü
Kod:
ActiveWorkbook.Worksheets(1).Select
bununla değiştir.

Kod:
ActiveWorkbook.Worksheets("jandarma").Select
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,758
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
5 nolu mesajdaki kodu güncelledim.
 

modoste

Altın Üye
Katılım
31 Mayıs 2008
Mesajlar
3,598
Excel Vers. ve Dili
Microsoft OFFİCE Ev ve İş 2019 TR
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:

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,758
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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:

modoste

Altın Üye
Katılım
31 Mayıs 2008
Mesajlar
3,598
Excel Vers. ve Dili
Microsoft OFFİCE Ev ve İş 2019 TR
son gönderdiğinizde çözüme ulaştım sayın halit hocam emeğinize sağlık
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,758
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Teşekkürler iyi çalışmalar
kodu yeniden güncelledim.
 

modoste

Altın Üye
Katılım
31 Mayıs 2008
Mesajlar
3,598
Excel Vers. ve Dili
Microsoft OFFİCE Ev ve İş 2019 TR
hocam güncelledim derken değiştirdiğiniz eklediğiniz bir detay mı var
 

modoste

Altın Üye
Katılım
31 Mayıs 2008
Mesajlar
3,598
Excel Vers. ve Dili
Microsoft OFFİCE Ev ve İş 2019 TR
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
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,758
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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
 

modoste

Altın Üye
Katılım
31 Mayıs 2008
Mesajlar
3,598
Excel Vers. ve Dili
Microsoft OFFİCE Ev ve İş 2019 TR
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.
 
Üst