Dosyanızı ekleyebilirsiniz
Cevaplanmışlara taşındığı için dosya eklenemiyordu
Tekrar Sorular bölümüne taşındı
gönderiyorum hocam, sayfada gerekli açıklamalar var, teşekkürler.
Ado ile yaptım eğer yavaş olursa bakarız.
süper olmuş elinize sağlık, çok çok teşekkür ederim, bayağı uzun listeler vardı bu sayede tek tıkla hallolacak, emeğiniz için çok teşekkürler.
Rica ederim.
Birde düşeyara manığı ile yaptım bu daha hızlı olması gerek.
Not:Kod ve dosya güncellendi.12.05.2022 21:40
Sub Arama()
Dim kitapVarmi As String
Dim syf As Worksheet: Set syf = ThisWorkbook.Worksheets("Sayfa1")
With syf
With .Range("B2:B" & .Cells(Rows.Count, 1).End(3).Row + 1)
syf.Range("B2:B" & Rows.Count).Clear
kitapVarmi = ThisWorkbook.path & Application.PathSeparator & syf.[G1] & ".xlsx"
If Dir(kitapVarmi) = "" Then GoTo sonSub
.Formula = "=IFERROR(VLOOKUP(" & syf.[A2].Address(0, 0) & ",'" & ThisWorkbook.path & _
Application.PathSeparator & "[" & syf.[G1] & ".xlsx]Sayfa1'!A:C,3,0),"""")"
.Value = .Value
End With
End With
sonSub:
Set syf = Nothing
End Sub
Private Sub CommandButton1_Click()
Arama
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "G1" Then Arama
End Sub
Çok iyi oldu icap ederse bunu da kullanırım, çok teşekkür ederim sayın feraz, işimiz gücümüz "işimiz" ve bu konuda çok yardımcı oluyorsunuz , işimizi kolaylaştırıyorsunuz, Allah emeğinizi karşılıksız bırakmasın , çok teşekkürler.