Soru Koşullu Veri Çekme

[murat_fidan]

Değerli arkadaşlar paylaşmış olduğum çalışma ile ANA LİSTE isimli sayfadan VERİ ÇEKME isimli sayfanın A sütununa verilerini çekmek istediğim personellerin TC kimlik numarasını yazarak durumu AKTİF olan personellerin verilerini çekmekteyim. Çalışma mevcut hali ile bunu yapmakta. Ancak verilerini çekmek istediğim personel sayısı örneğin 2000 kişi olunca mevcut makro bunu çok yavaş gerçekleştirmekte. Bu makroyu hızlandırmak mümkün müdür acaba. Saygılar

 

[Ziynettin]

.....

Sub kod()
Dim s1 As Worksheet, s2 As Worksheet
Set s2 = Sheets("VERİ ÇEKME")
Set s1 = Sheets("ANA LİSTE")
Set dc = CreateObject("scripting.dictionary")

son = s1.Cells(Rows.Count, 2).End(3).Row
a = s1.Range("A1:T" & son).Value
For i = 2 To UBound(a)
    If a(i, UBound(a, 2)) = "AKTİF" Then
        dc(CStr(a(i, 2))) = i
    End If
Next i

son = 0
son = s2.Cells(Rows.Count, 1).End(3).Row
b = s2.Range("A2:A" & son).Value
ReDim c(1 To UBound(b), 1 To 16)
For i = 1 To UBound(b)
    krt = CStr(b(i, 1))
    If dc.exists(krt) Then
        sat = dc(krt)
        c(i, 1) = a(sat, 1)
        c(i, 2) = a(sat, 3)
        c(i, 3) = a(sat, 4)
        c(i, 4) = a(sat, 5)
        c(i, 5) = a(sat, 7)
        For j = 10 To UBound(a, 2)
            c(i, j - 4) = a(sat, j)
        Next j
    End If
Next i

s2.[B2].Resize(UBound(b), 16) = c
MsgBox "İşlem tamam...", vbInformation
End Sub

 

[valentino06]

Sayın Ziynettin Hocam çok güzel kod hocam elinize ve sağlık hocam kapalı başka bir Excel den çekmek istesek bu koda nasıl ilave yapılabilir.