• Foruma hoş geldin 👋 Ziyaretçi

    Forum içeriğine ve tüm hizmetlerimize erişim sağlamak için foruma kayıt olmalı ya da giriş yapmalısınız. Foruma üye olmak tamamen ücretsizdir.

    Giriş yap veya Şimdi kayıt ol

Çözüldü Dosya Birleştirme Makrosu Düzeltme

Bu sorun verilen destek sayesinde çözüme ulaştırılmıştır.
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
bulentkars

bulentkars

Bronz Üye
Kullanıcı Bilgileri
Katılım
30 May 2022
Mesajlar
404
Çözümler
3
Aldığı beğeni
66
Excel Versiyonu
Office 365 TR
Konuyu Başlatan
Arkadaşlar Merhaba;

Aşağıdaki kod ile C:\Şubeler\ Klasörü altındaki dosyaları birleştiriyorum.
yapmak istediğim;
1 - Makro çalışacağız zaman önce klasör açılacak ben klasörden hangi yolu seçip tamam yaptığımda hangi yolu seçersem o yola göre çalışmasını istiyorum.
2 - Birde Kopyalama yaptığım sayfa adı C100_Kart Yerine aktif sayfaları birleştimesini istiyorum.

Aşağıdaki kodda yardımcı olabilirseniz sevinirim. Şimdiden Teşekkürler
C#:
Değerli Misafirimiz İçeriği Görebilmek İçin Üyemiz İseniz Giriş Yap'ın Ya da Üye Ol'un.
 
Tarihe göre sırala Oylara göre sırala
Application.ScreenUpdating = True

Yukardaki kodu en alt satıra doğru emlemişsiniz bu arada.
 
Olumlu oy 0 Negatif oyla
Merhaba;

Kodu çalıştırdım.
Dosya açılıyor,
yol olarak C:\Şubeler seçip tamam dediğimde aşağıdaki hatayı alıyorum. İlgili dosya ilgili adreste var olmasın arağmen
1700110072541.png

1700110125225.png
 
Olumlu oy 0 Negatif oyla
Sayın Refaz;
Kodunuz üzerinde değişlik yaptım oldu.
Sadece Klasör açılırken DEFAULT olarak C:\ Gelebilir mi?
Birde C100_KART Sayfasını pasif yaparak aktif sayfayı yapamadım. aşağıdaki nihai kod üzerinden yapabilirseniz sevinirim. Şİmdiden Teşekkürler

Sub Subeleri_Birleştir()

Dim yol As String, dosya As String, Sayfa(), sat As Long, i As Byte, a As Long, son As Long, s1 As Worksheet


ThisWorkbook.Activate

Set s1 = Sheets("Tümü")

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ThisWorkbook.Path & Application.PathSeparator
If .Show = -1 Then
dosyayolu = .SelectedItems(1)

Else

Exit Sub
End If
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' yol = "C:\Şubeler\"
yol = dosyayolu & "\"

dosya = Dir(yol & "\*.xlsm")
Sayfa = Array("C100_Kart")

Application.ScreenUpdating = False
s1.Range("A2:M" & Rows.Count).ClearContents 'eğer eski veriler silinmeyecekse bu satırı silersiniz.
sat = s1.Cells(Rows.Count, "A").End(xlUp).Row + 1

Do While dosya <> ""
Workbooks.Open yol & dosya

For i = 0 To UBound(Sayfa)
With Sheets(Sayfa(i))
say = i

If s1.Range("A1") = "" Then
.Range("A1:D1").Copy s1.Range("A1")


End If
son = .Cells(Rows.Count, "A").End(xlUp).Row
If son > 1 Then
.Range("A1:D" & son).AutoFilter Field:=4, Criteria1:="<>"
.Range("A2:D" & son).SpecialCells(xlCellTypeVisible).Copy s1.Cells(sat, "A") ' duruma göre a3 olailir
a = sat
sat = s1.Cells(Rows.Count, "A").End(xlUp).Row + 1

End If

End With
Next i

Workbooks(dosya).Close False
dosya = Dir

Loop


MsgBox "Şube Dosyaları Başarıyla Birleştirildi..", vbInformation, Application.UserName

End Sub
Genişletmek için tıkla...
 
Olumlu oy 0 Negatif oyla
Rica ederim,birkaç dosya ekleyin ve hangileri aktif sayfa olacak onuda yazın abey.
 
Olumlu oy 0 Negatif oyla
Merhaba;

Aslında şu da olabilir; klasör seçimi yaptıktan sonra
genelde klasör altındaki dosyalar hepsi aynı formatta olduğu için
ilk dosyanın içindeki sayfa isimlerini liste gösterse seçim yapacağım sayfaları birleştirse daha iyi olur.

Örneğin;
Makro çalışacak
Klasör seçimi yapılacak
en son birleştirilecek çalışma kitaplarının birinin içindeki sayfa isimleri gelecek.
sayfa1
sayfa2
sayfa4
data

ben sayfa4'ü seçip tamam dediğimde çalışma kitaplarındaki sayfa4 ler birleşecek.
 
Olumlu oy 0 Negatif oyla
Birkaç dosya ekleyin yardımcı olmaya çalışalım ben akşama bakabilirim ayrıca form kuralları gereği dosya eklemeniz gerek yoksa konu uzayıp duruyor.
 
Olumlu oy 0 Negatif oyla
Olumlu oy 0 Negatif oyla
Merhaba;
Klasör altındaki dosyalardan 3 adet ekledim.
Bu dosyalar alt alta birleşecek dosyalardır.
sayfa isimleri her 3 dosyada da aynı
Birleştirmelede çalışma kitaplarının C100_Kart sayfaları birleşmektedir.
Benim istediğim makroda Sayfa1 i seçtiğimde klasör altondaki tüm sayfa1 içindeki verileri birleştirmek istiyorum mümkünse.
Teşekkürler
 

Ekli dosyalar

  • A ADANA.xlsm
    90.7 KB · Gösterim: 2
  • A ANKARA.xlsm
    90.3 KB · Gösterim: 2
  • A BURSA.xlsm
    90.4 KB · Gösterim: 1
Olumlu oy 0 Negatif oyla
Gifteki gibi inputbox çıkınca 1,2... gibi yazın sayfa adı hangi birleşecekse.
11.Mesajdaki dosyalarınızı C Şubeler klasöre atın.A ADANA ve diğerleri aynı sayfalar dediğiniz için sayfaları A ADANA excelinden kod ile aldırdım.
Bu isim değişecekse koddanda değiştirin.Alttaki

Ziyaretçiler için gizlenmiş link,görmek için Giriş yap veya üye ol.
 

Ekli dosyalar

  • Test.xlsb
    32.8 KB · Gösterim: 1
Olumlu oy 0 Negatif oyla
Sayın Refaz;
Gif' teki görselde izledim çok güzel olmuş, yanlız makro bende çalışmıyor. sadece klasör seçip tamam dediğimde işlem yapmıyor.
Bende hazırda kullandığım 3 seçenekli sayfalar ile ilgili bir çalışma var çok güzel ve herkesin günlük hayatta kullanabileceği güzel bir çalışma ekte paylaştım.
Gif'te izlerken esinlendim. makroya 4.seçenek ÇALIŞMA KİTAPLARINI BİRLEŞTİR. adında olacak. seçilip tamam dediğimizde seçilen klasör altındaki tüm dosyaları alt alta birleştirmek istiyorum. illa benim ilk gönderdiğim makro olmasa da olur, elinize çalışma kitaplarını birleştiren bir makroda varsa 4.seçenek olarak eklense çok süper olur.
ilgi alakanız için çok teşekkür ederim.
 

Ekli dosyalar

  • Sayfalar Arası Makro.xlsb
    28.8 KB · Gösterim: 1
Olumlu oy 0 Negatif oyla
bulentkars' Alıntı:
makro bende çalışmıyor. sadece klasör seçip tamam dediğimde işlem yapmıyor.
Genişletmek için tıkla...
Koda eklediğim Kapalı sayfa(A ADANA) olanı silip tüm excellerde sayfa adı aratıp teke düşürüp yaptım.
Eki deneyin.Son sorduğunuza bakacağım.
 

Ekli dosyalar

  • Test.xlsb
    34.1 KB · Gösterim: 1
Olumlu oy 0 Negatif oyla
Merhaba;
Şimdi oldu, ancak ufak bir sorun tespit ettim bunu düzeltebilirsek sevinirim.
Klasör altındaki tablolar genelde aynı formatta
örneğin
ADANA sayfa adları C100_Kart , Sayfa1
ANKARA sayfa adları C100_Kart, Sayfa1
SAMSUN sayfa adları C100_Kart

samsun şubesinde sayfa 1 olmadığı için hata veriyor,
ilgili çalışma kitabında sayfa1 yoksa hata vermesin, sayfa1 olan diğer çalışma kitaplarını birleştirsin.
Başta yazdığım gibi bu hata çok önemli değil genelde dosyalar hep aynı formatta ama programın daha stabil çalışması için bu hatayı engelleyebilirsek güzel olur.

Bunu kodu önceki gönderdiğim tabloda 4.seçenek olarak eklersen çok iyi olur.
Hem de ihtiyacı olan kişiler bu dosyayı kullanabilecek.
İlgiliniz ve alakanız için çok teşekkür ederim.

Hatanın başına
on error resume next yazdığımda düzeldi.

Sadece bu kodu gönderdiğim dosya koduna 4.cü seçenek olarak eklemek kaldı. Teşekkürler


1700207438797.png

1700207384715.png
 
Olumlu oy 0 Negatif oyla
bulentkars' Alıntı:
samsun şubesinde sayfa 1 olmadığı için hata veriyor
Genişletmek için tıkla...
Hepsi aynı dediğiniz için yapmıştım.Neyse son 4.seçenek ile olan sorunuz için dosya hazırlamıştım onu deneyin ve dediğiniz hata olayına bakmadım sonra bakarım.

A sütununa Aylar eklemişsiniz 4 olanı seçerseniz bunlar siliniyor çünkü koda temizleme eklemişsiniz ve ayarlarsınız.
Birde dosyadaki modüller silinmeyecek.
 

Ekli dosyalar

  • Sayfalar Arası Makro.xlsb
    39.6 KB · Gösterim: 1
Olumlu oy 0 Negatif oyla
Hata olayınıda yaptım ama bazen açılan dosya kapanmıyor.Kodunuzu akşam tam ayarlarım yinede deneyin olmuş mu?
 

Ekli dosyalar

  • Sayfalar Arası Makro.xlsb
    40.5 KB · Gösterim: 1
Olumlu oy 0 Negatif oyla
Sayın Refaz;

Çok Çok Teşekkür ederim. Tüm kontrolleri yaptım.
Dosyanın Son hali ekte;
Dosya Birleştirmede Tümü sayfasını iptal ettim, 4 seçeneği seçildiğinde yeni sayfa oluşturup, aktif sayfaya birleştirme yapılmasını sağladım.
Sadece aklıma bir şey daha geldi bunu dinamik mi yapalım yoksa A1:XFD1 mi yapmalıyım. çünkü başka tablolarda aralık daha fazla olabilir. sizin öneriniz ne olur. A:D alanları geniş mi tutatalım yoksa kod ile dolu sutun mu yaparsak iyi olur.
Kod çok güzel oldu Allah sizden razı olsun. Eğer akşam tekrar kontrol yapacaksanız nihai tabloyu tekrar paylaşırsanız sevinirim.


If s1.Range("A1") = "" Then
.Range("A1:D1").Copy s1.Range("A1")


End If
son = .Cells(Rows.Count, "A").End(xlUp).Row
If son > 1 Then
.Range("A1:D" & son).AutoFilter Field:=4, Criteria1:="<>"
.Range("A2:D" & son).SpecialCells(xlCellTypeVisible).Copy s1.Cells(sat, "A")
 

Ekli dosyalar

  • Sayfalar Arası Makro Son.xlsb
    36.5 KB · Gösterim: 2
Olumlu oy 0 Negatif oyla
Sub Subeleri_Birlestir() bu kodu düzenledim.Değişkenlere atatım sheet ve workbook olarak.
 

Ekli dosyalar

  • Sayfalar Arası Makro Son.xlsb
    37.9 KB · Gösterim: 3
Olumlu oy 0 Negatif oyla
Durum
Konu Çözümlendiği İçin Kapatılmıştır.

Konuyu okuyanlar

Toplam: 2 (Kullanıcı: 0, Ziyaretçi: 2)
Geri
Üst