Çalışma sayfasındaki verileri. Kapalı excel dosyalarına değer olarak kaydetme/aktarma

[Bora K]

Merhabalar

B sütunundaki rakamları Değer Olarak kapalı excel dosyalarına yazdırmak istiyorum.

C sütununda yer alan isimler kapalı dosyaların muhtelif sayfalarında
H5 yada J5 hücrelerinde bir yada birden fazla olarak bulunuyorlar.
(aynı kitap içinde farklı sayfalarda yada farklı kitapların farklı sayfalarında)

Yazılacak Kod İlgili klasör içindeki tüm excel Dosyalarının bütün sayfalarında ki H5 ve J5 hücrelerini tarayacak.
Şayet ilgili hücrelerde Yandaki C sütunundaki isimleri tespit eder ise İlgili ismin yanındaki B sütunundaki rakamı değer olarak
yazacak.

Nasıl yazılacak ??

ÖRNEK :
Adem Karaca kapalı dosyanın H5 hücresinde ise;
Aynı sayfanın F14 hücresine Değer Olarak B sütunundaki 10 rakamı yazılacak.

Adem Karaca kapalı dosyanın J5 hücresinde ise şayet
10 rakamı bu kez aynı sayfanın G21 hücresine yazılacak

Aynı sayfada değilde farklı sayfa yada kitaplarda
Aynı isim hem H5 hemde J5 hücresinde bulunabilir.
Bu durumda her ikisinede üstte belirtilen kriterler dahilinde yazılması gerekiyor.
(İsmin bulunduğu sayfa ne kadar ise hepsine yazılacak)

Yazının uzunluğundan dolayı karışık gelebilir. İnşallah yardımcı olunur.
Saygılarımla.

 

[Bora K]

Tekrardan Merhabalar

Açıklama çokmu karışık oldu acaba?
Daha kısa ve net olarak yazmaya çalışayım.

Çalışma Sayfamızda ki B sütunundaki rakamları
Kapalı dosyalara aktarmak istiyoruz.

Yazılacak kod belirlediğimiz klasör içindeki tüm dosyaların tüm sayfalarında C sütunundaki isimleri arayacak.
C sütunundaki isim eğer H5 hücresinde ise B sütunundaki rakamı F14 hücresine
C sütunundaki isim eğer J5 hücresinde ise B sütunundaki rakamı G21 hücresi yazdıracağız.

Saygılarımla.

 

[Orion1]

Dosyanız ektedir.

Sub dosyalar59()
Dim dosya As String, yol As String, sayfa As Worksheet
Dim i As Long, sat As Long
yol = ThisWorkbook.Path & "\Yeni Klasör\"
dosya = Dir(yol & "*.xls")
sat = Cells(Rows.Count, "C").End(xlUp).Row

Do While dosya <> ""
    If Workbooks.Open(yol & dosya).ReadOnly Then
        Workbooks(dosya).Close False
    End If
        For Each sayfa In Workbooks(dosya).Worksheets
            For i = 4 To sat
                If Cells(5, "H").Value = ThisWorkbook.Sheets("Liste").Cells(i, "C").Value Then
                    Range("F14").Value = ThisWorkbook.Sheets("Liste").Cells(i, "B").Value
                End If
                If Cells(5, "J").Value = ThisWorkbook.Sheets("Liste").Cells(i, "C").Value Then
                    Range("G21").Value = ThisWorkbook.Sheets("Liste").Cells(i, "B").Value
                End If
            Next i
        Next
        Workbooks(dosya).Close True
    dosya = Dir
Loop
ThisWorkbook.Activate
MsgBox "İşlem tamamlanmıştır." & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName
End Sub

 

[Bora K]

Merhabalar
Evren Hocam.

Dosya yolunda değişiklik yapmamız mümkünmü acaba?
Kayıt yapacağım klasörleri açılan pencerede seçmek benim için
daha kullanışlı olacaktır. Teşekkür ederim.

 

[Orion1]

Merhabalar
Evren Hocam.

Dosya yolunda değişiklik yapmamız mümkünmü acaba?
Kayıt yapacağım klasörleri açılan pencerede seçmek benim için
daha kullanışlı olacaktır. Teşekkür ederim.

Dosyanız ektedir.

Sub dosyalar59()
Dim dosya As String, yol As String, sayfa As Worksheet
Dim i As Long, sat As Long, f As Object
Set f = CreateObject("Shell.Application").BrowseForFolder(0, _
    "Taranacak klasörü seçin", 0)
If f Is Nothing Then Exit Sub
yol = f.items.Item.Path
dosya = Dir(yol & "\" & "*.xls")
sat = Cells(Rows.Count, "C").End(xlUp).Row
Do While dosya <> ""
    If Workbooks.Open(yol & "\" & dosya).ReadOnly Then
        Workbooks(dosya).Close False
    End If
        For Each sayfa In Workbooks(dosya).Worksheets
            For i = 4 To sat
                If sayfa.Cells(5, "H").Value = ThisWorkbook.Sheets("Liste").Cells(i, "C").Value Then
                    sayfa.Range("F14").Value = ThisWorkbook.Sheets("Liste").Cells(i, "B").Value
                    ThisWorkbook.Sheets("Liste").Cells(i, "H").Value = "OK"
                End If
                If sayfa.Cells(5, "J").Value = ThisWorkbook.Sheets("Liste").Cells(i, "C").Value Then
                 ThisWorkbook.Sheets("Liste").Cells(i, "H").Value = "OK"
                End If
            Next i
        Next
        Workbooks(dosya).Close True
    dosya = Dir
Loop
ThisWorkbook.Activate
MsgBox "İşlem tamamlanmıştır." & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName
End Sub

 

[Bora K]

Merhabalar Evren Hocam.

Kodu deneme fırsatı buldum yenice.
Kod kapalı dosyalar; kapatıldığı anda hangi sayfa aktifse sadece o sayfanın ilgili hücresine kayıt yapıyor.

Biz ise; Tüm kitapların bütün sayfalarının (H5 ve J5 hücreleri taranacak)
taranması sonunda ne kadar sayıda veriye rastlanır ise (alt üst sınır yok)
hepsine verilerin yazılmasını istiyoruz.

Bu düzeltmeyi yapabilirseniz şayet müteşekkir olacağız.
Saygılarımla.

 

[Orion1]

Merhabalar Evren Hocam.

Kodu deneme fırsatı buldum yenice.
Kod kapalı dosyalar; kapatıldığı anda hangi sayfa aktifse sadece o sayfanın ilgili hücresine kayıt yapıyor.

Biz ise; Tüm kitapların bütün sayfalarının (H5 ve J5 hücreleri taranacak)
taranması sonunda ne kadar sayıda veriye rastlanır ise (alt üst sınır yok)
hepsine verilerin yazılmasını istiyoruz.

Bu düzeltmeyi yapabilirseniz şayet müteşekkir olacağız.
Saygılarımla.

dosya güncellendi 5 numaralı mesajdan indirebilirsiniz.

 

[Orion1]

Bir yerde eksik varmış.
tekrar doayayı 5 nolu mesaja yükledim.,
Dosyayı oradan indirebilirsiniz.

 

[Bora K]

Merhabalar

Evren Hocam son güncellediğiniz kodu denedim.
Tüm sayfalara kayıt yapmama sorunu giderilmiş.

Yeni kodda şu şekilde bir durum var.
Aynı sayfa içinde hem H5 hemde J5 hücrelerinde isim olduğu durumlarda
F14 ve G21 hücrelerine kayıt yapıyor idik.

Kapalının aktif sayfasında her iki hücreyede kayıt yapıyor
Lakin diğer sayfalarda sadece F14 hücresine kayıt yapıyor.

Tekrar bakabilirmisiniz acaba ?

 

[Orion1]

Merhabalar

Evren Hocam son güncellediğiniz kodu denedim.
Tüm sayfalara kayıt yapmama sorunu giderilmiş.

Yeni kodda şu şekilde bir durum var.
Aynı sayfa içinde hem H5 hemde J5 hücrelerinde isim olduğu durumlarda
F14 ve G21 hücrelerine kayıt yapıyor idik.

Kapalının aktif sayfasında her iki hücreyede kayıt yapıyor
Lakin diğer sayfalarda sadece F14 hücresine kayıt yapıyor.

Tekrar bakabilirmisiniz acaba ?

ben onu bu arada tekrar güncelledim.
Tekrar indirip bakarmısınız 5 nolu ömesajdaki dosyaya

 

[Bora K]

Sayın Evren Hocam.
Şuan için kusursuz oldu makromuz.
Ellerinize dert görmesin. Zihninize sağlık.

Saygılarımla.

 

[Bora K]

Merhabalar
Evren Hocam

Kodu kullanmaya başladıktan sonra farkedebildim ancak.
Özür dilerim tekrardan rahatsızlık verdiğim için.

"Çalışma Sayfası" kitabında (Makroyu tetiklediğim sayfa) nın H sütununa
sadece aktarılan verileri "ok" yazısı ile işaretleme
imkanımız varmı acaba?

NOT: Kod listedeki verilerle kapalı dosyanın verilerini karşılaştırıp eşleşme
sağlandığı durumlarda kayıt yapıyor.

 

[Orion1]

Merhabalar
Evren Hocam

Kodu kullanmaya başladıktan sonra farkedebildim ancak.
Özür dilerim tekrardan rahatsızlık verdiğim için.

"Çalışma Sayfası" kitabında (Makroyu tetiklediğim sayfa) nın H sütununa
sadece aktarılan verileri "ok" yazısı ile işaretleme
imkanımız varmı acaba?

NOT: Kod listedeki verilerle kapalı dosyanın verilerini karşılaştırıp eşleşme
sağlandığı durumlarda kayıt yapıyor.

A dosyasınamı işaretlenecek,B dosyasınamı?
Ayrıca B dosyasının A1 hücresindeki veriye göre aktarma yapıyor.

 

[Bora K]

Örneklermi karıştı acaba
Evren Hocam.
5 Nolu mesajda dosyamızın son hali
var. 5 nolu mesajdaki örneğe göre.

"Çalışma sayfası" kitabında işaretleme yapılacak.
(Makro bu sayfadan tetitleniyor.) (Açık kitap)

 

[Orion1]

Örneklermi karıştı acaba
Evren Hocam.
5 Nolu mesajda dosyamızın son hali
var. 5 nolu mesajdaki örneğe göre.

"Çalışma sayfası" kitabında işaretleme yapılacak.
(Makro bu sayfadan tetitleniyor.) (Açık kitap)

Dosyayı güncelledim.
5 nolu mesajdan indirebilirsiniz.

 

[Bora K]

Evren hocam çok özür dilerim.

Yanlış anlaşıldım. Ekteki dosyada
gösterdim. OK yazıları makronun tetiklendiği
sayfaya konacak. Verilerin yanına

 

[Orion1]

Evren hocam çok özür dilerim.

Yanlış anlaşıldım. Ekteki dosyada
gösterdim. OK yazıları makronun tetiklendiği
sayfaya konacak. Verilerin yanına

5 nolu mesajdan dosyayı indirebilirsiniz.

 

[Bora K]

Çok teşekkür ederim Evren Hocam

Kod bu hali ile harika oldu. Önceden kapalıları açıp kontrol ediyordum
yazmışmı yazmamışmı diye.

Herşey gönlünüzce olsun inşallah.