• DİKKAT

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

Birçok dosyadaki bilgileri bir sayfaya Birleştime makrosu

G

gedavet

Katılım
15 Eylül 2007
Mesajlar
1,312
Excel Vers. ve Dili
2013 türkçe
sayın hocalarım ekteki dosyada bir birleştirme makrosu var ancak bu kod verileri önce dizi içine alıyor. Sonra tabloya aktarıyor. şu andaki ayır birleştir dosyasındaki aktarma bu şekilde.

yapmak istediğim dosyaları tek tek açıp kopyalayıp yapıştırır gibi sayfadaki formülleri ve biçimlendirmeyi dahil hepsini birleştirdiği sayfa o şekilde aktarmasını istiyorum

dosyalar klasöründe birçok dosya olacak bu klasörün içindeki sayfanın içindeki şekli ile aynen aktarmak istiyorum

bu kodda bu şekilde düzeltme yapıverebilir misiniz

şimdiden çok teşekkür ederim yardımlarınız için
 

Ekli dosyalar

hocalarım bana yardımcı olabilir misiniz
bu koda çok ihtiyacım var
 
sayın hocalarım bu makroyu yapmak için yardımcı olabilirmisiniz
 
hocam bu konuya çok ihtiyacım var bana yardımcı olabilirmisiniz
 
hüseyin hocam çok teşekkür ederim emeğinize sağlık allah razı olsun

ancak birleştireceğim dosya 200 - 300 tane olursa hata veriyor
birleştireceğim dosyadaki listenin satırları az olduğu için
ne kadar satır ihtiyacı olduğunu bilemem onun için hata vermeden birleştirebilirmi
 
. . .

Satıra sınır koymadım.
Ben örnekte hata almadım. F8 ile kodları adım adım çalıştırın. Hata aldığınız kapalı dosyada farklı bir durum vardır. Onu tespit edin. İnceleyelim.

. . .
 
hüseyin hocam dosyalar klasörünün içindeki sayfalarda içinde birden fazla sayfa var ondanmış sadece baştaki sayfayı aktaracak
 
. . .

Kodlar açılışta aktif olan sayfadan veri alır.
Eğer tüm tablolarda veri alınacak sayfa ismi sabitse kodlardaki şu satırı değiştirin.
S1 = ActiveSheet.Name yerine S1 = "Sayfa1"

. . .
 
hüseyin hocam dediğinizi yaptım buseferde formüllü olan yerleri sadece sayı olarak aldı formülleri almadı
acaba önce dosyayı ayırma kodu ile ayırırken şifre veriyor

ActiveSheet.Protect Password:=("deneme"), DrawingObjects:=True, Contents:=True, Scenarios:=True 'şifreler

bundan olabilirmi
 
. . .

Yaptığımız değişiklik formülleri etkilemez.
Örnek dosya yükleyin inceleyelim.

. . .
 
hocam dosyayı ekledim

işlem şu şekilde işliyor
önce ayırıyoruz dosyayı başkasına verip işlem yaptırıyoruz sonra birleştiriyoruz
şu anda birleştirmede hata var
 

Ekli dosyalar

. . .

http://www.excel.web.tr/f59/rnek-dosya-hazyrlarken-dikkat-edilmesi-gerekenler-t134225.html

Kod: 
Sub BİRLESTİR()

    If MsgBox("             E M İ N M İ S İ N İ Z ?", vbYesNo, "Dikkat!") = vbNo Then Exit Sub
    Dim NumFound As Long, sno As Long, satir As Long, yurtSutunu As Long, ilkSatir As Long
    Dim dosyaYeri As String, sifre As String
    
    Dim SK As Worksheet, SA As Worksheet
    Dim SK1 As Workbook
    Set SA = Workbooks("AYIR BİRLEŞTİR").Sheets("Liste")
    
    dosyaYeri = Cells(1, 2).Value
    sifre = Cells(1, 6).Value
    sat = 4
    SA.Range("B4:K" & Rows.Count).Clear

    sDir = Dir$(dosyaYeri & "\*.xls*", vbNormal)
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    
    Do Until LenB(sDir) = 0
        dosya = dosyaYeri & "\" & sDir
        Workbooks.Open dosya, Password:=sifre, UpdateLinks:=0
        S1 = "LİSTE"
        Set SK1 = Workbooks(sDir)
        Set SK = Workbooks(sDir).Sheets(S1)
        On Error Resume Next
        SK.Select
        ActiveSheet.Unprotect Password:=("deneme")
        On Error GoTo 0
        son = SK.Cells(Rows.Count, "B").End(3).Row
        SK.Range("B4:K" & son).Copy SA.Cells(sat, "B")
        sat = (sat - 4) + son + 1
        
        sDir = Dir$
        
        SK.Protect Password:=("deneme"), DrawingObjects:=True, Contents:=True, Scenarios:=True 'şifreler
        SK1.Close , False
        Set SK1 = Nothing
        Set SK = Nothing
        
    Loop
    Application.ScreenUpdating = True: Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
End Sub

. . .
 
allah razı olsun hüseyin hocam çok teşekkür ederim emekleriniz için güzel bir çalışma oldu
ayır mailat birleştir işlemi
 
hüseyin yapıverdiğiniz dosyayı kullanıyorum çok işime yaradı çok teşekkür ederim

ekteki dosyadaki birleştir dosyasında tablo satırlarına eklemiyor birleştirme makrosu

yardımcı olabilir misiniz
ilk dosyamdaki kod bu işlemi yapıyordu aslında ordan alıntı yapılacaksa

hocam özetleyecek olursam birleştirme kodu bilgileri birleştirince tablo satırına ilve etmiyor birinci dosyadan sonrasını nekadar çok dosya olursa olsun ilk dosyayı tablo satıra aktarıyor sonrasını tablo satırına eklemiyor
 

Ekli dosyalar

. . .

Tablo özelliği pek kullanmıyorum.

End Sub satırından önce şu kodları ekleyerek deneyiniz.

Kod: 
    sonadres = Cells(Rows.Count, "K").End(3).Address
    ActiveSheet.ListObjects("Tablo1").Resize Range("$B$3:" & sonadres)

. . .
 
hüseyin hocam çok teşekkür ederim tamam oldu tablo satırlarına ekliyor
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst