DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sayın veyselemre,Scripting.Dictionary kullanarak bir çözüm hazırladım, umarım doğru çalışıyordur.
Scripting.Dictionary mükemmel bir script. Forumda ilk kez kullanılıyor sanırım, şimdiye kadar kullanılmaması çok büyük bir kayıp.
Kusura Bakmayın uzantısı zip olacaktı, dosyayı güncelliyorumSayın veyselemre,
Bunu hangi programla açacağız?
Ben açamadım.
..
Sub ARA_BUL_LİSTELE()
Set SA = Sheets("arama")
Set WF = WorksheetFunction
SA.[B:IV].ClearContents
For X = 1 To SA.[A65536].End(3).Row
For Y = 1 To Sheets.Count - 1
If WF.CountIf(Sheets(Y).[A:Z], "*" & SA.Cells(X, 1) & "*") > 0 Then
SATIR = Sheets(Y).Cells.Find(SA.Cells(X, 1), LookAt:=xlPart).Row
SÜTUN = SA.Cells(X, 256).End(xlToLeft).Column + 1
SA.Cells(X, SÜTUN) = Sheets(Y).Cells(SATIR, 1)
End If: Next: Next
Set SA = Nothing
Set WF = Nothing
MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub