Aynı hücreleri bulup adreslerini yazdırma

[selims73]

İyi çalışmalar, Benim bir sorunum var yardımcı olursanız sevinirim.
Sorunum şu;6 Sayfalık bir excel çalışma kitabında, 2. sayfadaki b sutununda ki tüm değerleri tek tek tüm sayfalarda aratıp aynı değerde olan hücreleri 7. bir sayfa oluşturup 7. sayfada adresleri yazdırmak istiyorum. örneğin 2. sayfadaki B1 hücresinde yer alan değer hangi sayfanın hangi hücresinde yer alyorsa 7. sayfanın b1 hücresine bu adres ya da adresler yazsın
şimdiden yardımlarınız için teşekkürler

 

[N.Ziya Hiçdurmaz]

yanıt

Bir örnek hazırladım inceleyiniz.

Sub TEST()
Dim S1, S2 As Worksheets
Dim SUT1, SUT2 As Long
Set S1 = Sheets("Sayfa1")
Set S4 = Sheets("Sayfa4")
S4.[a2:a100].ClearContents
S = 1
For I = 2 To Sheets.Count
For SUT1 = 1 To S1.[B65536].End(3).Row
For SUT2 = 1 To Sheets(I).[B65536].End(3).Row
If S1.Range("B" & SUT1) = Sheets(I).Range("B" & SUT2) Then
S = S + 1
S4.Range("A" & S) = Sheets(I).Range("B" & SUT2).Address
End If
Next
Next
Next
Set S1 = Nothing
Set S4 = Nothing
End Sub