• DİKKAT

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

Kapalı Excele veri yazdırma

Katılım
19 Şubat 2007
Mesajlar
630
Excel Vers. ve Dili
Ofis 365 Tr- 64 Bit
Sayın Excel Hocalarım desteğinize ihtiyacım var. açık olan Excel kitabımdan kapalı Excel kitabına 2 şarta göre veri yazdırmak istiyorum. lütfen yardımcı olabilir misiniz.
Açık olan Excel Kitabım : "Vardiya programı" Kapalı olan ve verileri yazdırmak istediğim Excel'in adı her hafta değişiyor. kapalı olan Excel ortak alanda duruyor. Tanımlıya cağımız yola göre verileri yazacak şartlar ise Personel adı , Çalıştığı Bölüm Her iki Excel de de Personel adı ve bölüm eşit ise yanı aynı ise veriyi yazsın istiyorum. Vardiya Programı Excel kitabı içinde veri sayfasındaki sarı ile boyadığım verileri kapalı Excel kitabındaki Personel Listesi Sarı ile boyadığım yere yazsın istiyorum. lütfen yardımcı olabilir misiniz.
 

Ekli dosyalar

Arkadaşlar örnek Excel'i eklemeyi unutmuşum lütfen yeni yüklediğim Excel üzerinden bakabilir misiniz.
 

Ekli dosyalar

Arkadaşlar lütfen yardımcı olabilir misiniz.

Saygılarımla,
İyi çalışmalar.
 
Forumda örnekler var. İnceleyip kendi dosyanızı uyarlamalısınız.

 
Ek olarak bu linkleride inceleyiniz.



 
Sayın Korhan Ayhan Hocam linkleri inceledim. hepsini kopyalama yapıyor. Hocam benim yapmak istediğim kapalı Excel de 2500 adet kişi var benim açık Excel de 200 kişi var 200 kişiyi kapalıda bulsun ve verileri yazmasını istiyorum. kriter ise personel adı ve Çalıştığı bölüm olacak Hocam lütfen Yardımcı olabilir misiniz. çok teşekkür ederim.

Saygılarımla,
İyi çalışmalar.
 
Verdiğim linker örnek kodlamalar içeriyor. Onlardan işinize yarayan bölümleri kendi dosyanıza uyarlamanız gerekiyor.

Ben bu aralar müsait değilim. Sorunuz cevapsız kalmasın diye ilgili linkleri paylaştım. Müsait olan arkadaşlar umarım yardımcı olurlar.

Kolay gelsin..
 
Çok teşekkür ederim. Hocam çok sağ olun.

Saygılarımla,
İyi çalışmalar.
 
Merhaba, örnek dosyayı dosya tc gibi bir siteye yükleyip linkini paylaşırmısın
 
tamam çok teşekkür ederim.

Senin çalışma kitabında nedense kodlar doğru sonuç vermiyordu. Yeni bir çalışma kitabında denedim oluyor. Fakat senin çalışma kitabına uyarlamam lazım. Dosya tc sitesindeki linkten dosyan silinmiş, tekrar yüklermisin.
 
Sinan hocam yarın iş yerinden yüklerim. Pc yanımda değil. Çok teşekkür ederim.
 
Sinan hocam yarın iş yerinden yüklerim. Pc yanımda değil. Çok teşekkür ederim.

Rica ederim. Çalışma kitabının adı, klasör adı ve veriler hangi sütunda? Bunlar aklındaysa yazıver, ben uyarlayım biçimlendirmeyi sen yaparsın. Yarın iş yerinde olmayabilirim.
 
Bu siteye yüklediğin dosyayı indirebilirsin
 
Bu kodlar yeni oluşturduğum kitapda çalışıyor. Yeni klasör (2) masaüstünde olacak ve içinde direk kapalı dosya olacak. 1 den fazla dosyaya da işlem yapar. Denermisin.

Kod:
Sub Veri_Aktar()
Application.ScreenUpdating = False
Set S1 = Sheets("Veri")
Dim evn As Object, klasoradi As String, kitap As Workbook
Dim i As Integer, Dosyam As Workbook
Set kitap = ThisWorkbook
klasoradi = "Yeni klasör (2)"
Set evn = CreateObject("scripting.filesystemobject")
Set dosyalar = evn.getfolder(ThisWorkbook.Path & Application.PathSeparator & klasoradi)
For Each klasor In dosyalar.Files
Set Dosyam = Application.Workbooks.Open(klasor.Path)
    For i = 1 To Dosyam.Sheets.Count
    Son = S1.Range("D65536").End(3).Row
    Son1 = Dosyam.Sheets(i).Range("E65536").End(3).Row
       For x = 5 To Son
       For y = 2 To Son1
          If S1.Cells(x, "D") = Dosyam.Sheets(i).Cells(y, "C") And S1.Cells(x, "P") = Dosyam.Sheets(i).Cells(y, "B") Then
          Dosyam.Sheets(i).Cells(y, "E") = S1.Cells(x, "F")
          Dosyam.Sheets(i).Cells(y, "G") = S1.Cells(x, "G")
          Dosyam.Sheets(i).Cells(y, 7).Resize(, 12).Value = S1.Cells(x, 9).Resize(, 13).Value
          End If
         Next y
        Next x
       Next i
     Dosyam.Close True
  Next klasor
Set evn = Nothing: Set kitap = Nothing: Set Dosyam = Nothing
Application.ScreenUpdating = True
End Sub
 
Geri
Üst