Soru Kapalı Klasörden Veri Çekememe

[Turgay KARAŞAH]

Değerli üstadlarım sevgi ve saygılarımı sunarım.
Sorunumu arz edersem; ARAMA klasörüne 10. ve 11. sınav kılasöründe değişiklik yaptığımda eski bilgiler geliyor. kapalı klasör 10 ve 11 de ilgili hücrelere "basımda" ve "geldi" yazmama rağmen ARAMA klasöründe "0" gelmekte hücrelere veri çekemiyorum. Sebebini anlayamadım. teşekkürler.

 

[Turgay KARAŞAH]

yardım lütfen...

 

[Orion1]

Klasörden kastınız dosya sanırım.Klasör , dosyaların içinde tutulduğu bir yerdir.

 

[muygun]

Merhaba;
Deneyin.
İyi çalışmalar.

 

[Turgay KARAŞAH]

Sayın Orıon 1 doğrudur uyarınız için teşekkürler.

 

[Turgay KARAŞAH]

Merhaba;
Deneyin.
İyi çalışmalar.

Sayın Muygun ellerinize sağlık, teşekkür ederim. Kodsuz yapılamıyor anladığım kadarıyla. Kodu göremedim. Yoksa yeni dosyaları datanın içine mi yazacağım. teşekkürler

 

[Turgay KARAŞAH]

Klasörden kastınız dosya sanırım.Klasör , dosyaların içinde tutulduğu bir yerdir.

Sayın Orıon 1 doğrudur uyarınız için teşekkürler. Excelle yapılamıyor herhalde.

 

[muygun]

Sayın Muygun ellerinize sağlık, teşekkür ederim. Kodsuz yapılamıyor anladığım kadarıyla. Kodu göremedim. Yoksa yeni dosyaları datanın içine mi yazacağım. teşekkürler

Merhaba;
A R A M A-ADB-01.04.2019 dosyasında boş bir modüle;

Sub dosyaları_birlestir()
Dim fso As Object, f As Object, dosya As String, fls As Object
Dim sonsat1 As Long, sonsat2 As Long, sh As Worksheet, liste()
Set fso = CreateObject("Scripting.FileSystemObject")
burası = ThisWorkbook.Path
Set f = fso.getfolder(burası & "\SINAV BAŞVURULARI\").Files
ThisWorkbook.Activate
Set s1 = ThisWorkbook.Worksheets("data")
Application.ScreenUpdating = False
s1.Range("A3:k65536").ClearContents
For Each fls In f
If fso.GetExtensionName(fls) = "xlsx" Or fso.GetExtensionName(fls) = "xls" Then
If Workbooks.Open(fls).ReadOnly = True Then Workbooks(fls.Name).Close False
For Each sh In Workbooks(fls.Name).Worksheets
If sh.Name = "ALFABETİK" Then
sonsat1 = sh.Cells(65536, "c").End(xlUp).Row
If sonsat1 >= 4 Then
liste = sh.Range("a4:k" & sonsat1).Value
sonsat2 = s1.Cells(65536, "b").End(xlUp).Row + 1
s1.Range("a" & sonsat2).Resize(UBound(liste), 11) = liste
Erase liste
End If
End If
Next sh
Workbooks(fls.Name).Close False
End If
Next fls
ThisWorkbook.Activate
Application.ScreenUpdating = True
MsgBox "İşlem Bitti.", vbInformation
End Sub

Sub adsoyadagöregetir()
Set s1 = ThisWorkbook.Worksheets("data")
Set s2 = ThisWorkbook.Worksheets("İSME GÖRE")
s2.Range("b7:ıv65536").ClearContents

For k = 7 To s2.Range("a65536").End(xlUp).Row
For i = 3 To s1.Range("b65536").End(xlUp).Row
If s1.Cells(i, "b") = s2.Cells(4, "b") And s1.Cells(i, "f") = s2.Cells(k, "a") Then

s2.Cells(k, "b") = s1.Cells(i, "c") 'dosya no
s2.Cells(k, "c") = s1.Cells(i, "d") 'tc kimlik
s2.Cells(k, "d") = s1.Cells(i, "e") 'telefon
s2.Cells(k, "e") = s1.Cells(i, "f") 'sınavı
s2.Cells(k, "f") = s1.Cells(i, "g") 'eksikler
s2.Cells(k, "g") = s1.Cells(i, "h") 'başarı notu
s2.Cells(k, "h") = s1.Cells(i, "ı") 'başarı durumu
s2.Cells(k, "ı") = s1.Cells(i, "j") 'kart durumu
s2.Cells(k, "j") = s1.Cells(i, "k") 'adb belgesi

End If
Next i
Next k
End Sub

Sub tcgöregetir()
Set s1 = ThisWorkbook.Worksheets("data")
Set s2 = ThisWorkbook.Worksheets("TC NO GÖRE")
s2.Range("b7:ıv65536").ClearContents

For k = 7 To s2.Range("a65536").End(xlUp).Row
For i = 3 To s1.Range("b65536").End(xlUp).Row
If s1.Cells(i, "d") = s2.Cells(4, "b") And s1.Cells(i, "f") = s2.Cells(k, "a") Then

s2.Cells(k, "b") = s1.Cells(i, "c") 'dosya no
s2.Cells(k, "c") = s1.Cells(i, "d") 'tc kimlik
s2.Cells(k, "d") = s1.Cells(i, "e") 'telefon
s2.Cells(k, "e") = s1.Cells(i, "f") 'sınavı
s2.Cells(k, "f") = s1.Cells(i, "g") 'eksikler
s2.Cells(k, "g") = s1.Cells(i, "h") 'başarı notu
s2.Cells(k, "h") = s1.Cells(i, "ı") 'başarı durumu
s2.Cells(k, "ı") = s1.Cells(i, "j") 'kart durumu
s2.Cells(k, "j") = s1.Cells(i, "k") 'adb belgesi

End If
Next i
Next k
End Sub

kodlarını ekleyin.

İSME GÖRE sayfasında;
dosyaları_birlestir ve adsoyadagöregetir butonları oluşturup aynı isimli makroları atayın.
TC NO GÖRE sayfasında;
dosyaları_birlestir ve tcgöregetir butonları oluşturup aynı isimli makroları atayın.
sayfalarda önce birleştirme sonrada getir butonlarını kullanarak sonucu gözlemleyin.

İyi çalışmalar.

 

[Turgay KARAŞAH]

Tek kelimeyle harika. Emeğinize yüreğinize sağlık. İnanın hizmetlerinizi kelimelere sığdırmak mümkün değil. İşlerimizi öylesine kolaylaştırıyorsunuz ki....Allah siz ve sizingibilerinden razı olsun. Teşekkürler üstadım. Sevgive saygılarımı sunarım...