irfem4
Altın Üye
- Katılım
- 30 Kasım 2010
- Mesajlar
- 193
- Excel Vers. ve Dili
- 2010 tr
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Listele()
Dim rng As Range
Dim c As Range
Dim adr As String
Dim arn As String
Dim r As Long
arn = Sayfa2.Range("b2")
Set rng = Sayfa1.Range("A1").CurrentRegion
r = 3
Sayfa2.Range("B3").CurrentRegion.Offset(2).ClearContents
With rng
Set c = .Find(arn, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
adr = c.Address
Do
r = r + 1
Sayfa2.Cells(r, 2) = rng(c.Row, 1).Value
Sayfa2.Cells(r, 3) = c.Offset(0, 1).Value
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> adr
End If
End With
End Sub
bilginize ve emeğinize sağlık kod çalışıyor. Set rng = Sayfa1.Range("A2").CurrentRegion satırındaki A1 yapınca doğru sonuç veriyor.Merhaba,
Kodları bir modüle kopyalayıp deneyiniz.
Kod:Sub Listele() Dim rng As Range Dim c As Range Dim adr As String Dim arn As String Dim r As Long arn = Sayfa2.Range("b2") Set rng = Sayfa1.Range("A2").CurrentRegion r = 3 With rng Set c = .Find(arn, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then adr = c.Address Do r = r + 1 Sayfa2.Cells(r, 2) = rng(c.Row, 1).Value Sayfa2.Cells(r, 3) = c.Offset(0, 1).Value Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> adr End If End With End Sub