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

bulentkars · 16 Kas 2023

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
HTML:

C#:

İçeriği görebilmek için Giriş yap ya da Üye ol.

Refaz · 16 Kas 2023

Merhaba.
Bir deneyin.

HTML:

C#:

İçeriği görebilmek için Giriş yap ya da Üye ol.

Refaz · 16 Kas 2023

Application.ScreenUpdating = True

Yukardaki kodu en alt satıra doğru emlemişsiniz bu arada.

bulentkars · 16 Kas 2023

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

bulentkars · 16 Kas 2023

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("A11").Copy s1.Range("A1")

End If
son = .Cells(Rows.Count, "A").End(xlUp).Row
If son > 1 Then
.Range("A1" & son).AutoFilter Field:=4, Criteria1:="<>"
.Range("A2" & 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

Refaz · 16 Kas 2023

Rica ederim,birkaç dosya ekleyin ve hangileri aktif sayfa olacak onuda yazın abey.

bulentkars · 16 Kas 2023

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.

Refaz · 16 Kas 2023

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.

Refaz · 16 Kas 2023

bulentkars' Alıntı:
Sadece Klasör açılırken DEFAULT olarak C:\ Gelebilir mi?

HTML:

Kod:

İçeriği görebilmek için Giriş yap ya da Üye ol.

With Application.FileDialog(msoFileDialogFolderPicker) bu kodun üst satırına yukardakini ekleyip düzeltin harfi.

Refaz · 16 Kas 2023

Refaz' Alıntı:
With ActiveSheet

K zamana kadar yukardaki activesheet yerine sheets("Birleşecek sayfa adı")
Olarak değiştirin aynılar birleşecekse.Dediğim gibi dosya ekleyin halladelim.

bulentkars · 16 Kas 2023

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

Refaz · 17 Kas 2023

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

Bu bağlantı ziyaretçiler için gizlenmiştir. Görmek için lütfen giriş yapın veya üye olun.

bulentkars · 17 Kas 2023

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.

Refaz · 17 Kas 2023

bulentkars' Alıntı:
makro bende çalışmıyor. sadece klasör seçip tamam dediğimde işlem yapmıyor.

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.

bulentkars · 17 Kas 2023

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

Refaz · 17 Kas 2023

bulentkars' Alıntı:
samsun şubesinde sayfa 1 olmadığı için hata veriyor

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.

Refaz · 17 Kas 2023

Hata olayınıda yaptım ama bazen açılan dosya kapanmıyor.Kodunuzu akşam tam ayarlarım yinede deneyin olmuş mu?

bulentkars · 17 Kas 2023

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

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

1").Copy s1.Range("A1")

End If
son = .Cells(Rows.Count, "A").End(xlUp).Row
If son > 1 Then
.Range("A1

" & son).AutoFilter Field:=4, Criteria1:="<>"
.Range("A2

" & son).SpecialCells(xlCellTypeVisible).Copy s1.Cells(sat, "A")

Refaz · 17 Kas 2023

bulentkars' Alıntı:
A1:XFD1

Bunun yerine son dolu sütun bulunabilinir zaten basit kod.
Sizdende Allah razı oldun.

Skşama sütun ve dosya açma kapatma olayını yaparım eklediğiniz dosya için.

Refaz · 17 Kas 2023

Sub Subeleri_Birlestir() bu kodu düzenledim.Değişkenlere atatım sheet ve workbook olarak.

DİKKAT !
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 Dosya Yükleme tamamen ücretsizdir.

Giriş yap veya Şimdi kayıt ol

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

bulentkars

Refaz

Refaz

Refaz

bulentkars

bulentkars

Refaz

bulentkars

Refaz

Refaz

Refaz

bulentkars

Ekli dosyalar

Ekli dosyalar

Ekli dosyalar

Refaz

Ekli dosyalar

bulentkars

Ekli dosyalar

Refaz

Ekli dosyalar

bulentkars

Refaz

Ekli dosyalar

Refaz

Ekli dosyalar

bulentkars

Ekli dosyalar

Refaz

Refaz

Ekli dosyalar

DİKKAT ! 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 Dosya Yükleme tamamen ücretsizdir. Giriş yap veya Şimdi kayıt ol

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

DİKKAT !
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 Dosya Yükleme tamamen ücretsizdir.

Giriş yap veya Şimdi kayıt ol