Soru Kapalı Klasörden Veri Çekememe

Turgay KARAŞAH

Altın Üye
Katılım
21 Mayıs 2009
Mesajlar
82
Excel Vers. ve Dili
LAZEXC
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.
 

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Klasörden kastınız dosya sanırım.Klasör , dosyaların içinde tutulduğu bir yerdir.:cool:
 

muygun

Özel Üye
Katılım
6 Temmuz 2004
Mesajlar
9,103
Excel Vers. ve Dili
Excel-2003 Türkçe
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

Altın Üye
Katılım
21 Mayıs 2009
Mesajlar
82
Excel Vers. ve Dili
LAZEXC
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...
 
Üst