DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub AraBulAdresGoster()
Dim i As Long
Dim j As Integer, _
Kol As Integer
Dim c As Range
Dim Adr As String
Dim sr As Worksheet, _
sd As Worksheet
Set sd = Sheets("DATA")
Set sr = Sheets("RAPOR")
Application.ScreenUpdating = False
sr.Select
Kol = sr.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
i = sr.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
sr.Range(sr.Cells(2, "A"), sr.Cells(i, Kol)).ClearContents
For j = 1 To Kol
i = 1
With sd.Cells
Set c = .Find(sr.Cells(1, j), LookIn:=xlValues)
If Not c Is Nothing Then
Adr = c.Address
Do
i = i + 1
sr.Cells(i, j) = sd.Name & "!" & c.Address
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End With
Next j
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlanmıştır....", vbInformation
End Sub
Sayın Necdet Yeşertener, büyüksünüz vesselam. Çok çok teşekkür ederim. Allah sizleri yetiştirenlerden razı olsun. Sağlıcakla kalın.