Yazılmış makro kodunu genişletmek

[ates_2001]

Sub aktarim_yap()

sat = 20
With Sheets("Sayfa2").Range("B:B")
Set c = .Find(Sheets("baslik").Range("D3"), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
ilkadres = c.Address
Do
Sheets("baslik").Cells(sat, "A") = Sheets("Sayfa2").Cells(c.Row, "C")

sat = sat + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> ilkadres
End If
End With

End Sub

yazılmış olan kod "baslik" sheet'inin "D3" hücresine yazılan verinin "sayfa2" sheet'indeki "C" hücresindeki bilgiyi kodda görüldüğü gibi A20 hücresine atıyor.

Sorum şu başka bir sayfada örneğin "sayfa3" sayfasında "D3" hücresiyle aynı olan verinin örnek olarak "sayfa3" deki d hücresini yine "baslik" sheetinin "A9" hücresine atamak isitoyrum,.

Yani ben "D3" hücresine "ali" yazdığım zman "sayfa2" deki alinin karşısındaki bilgiyi "baslik" sayfasındaki A20 hücresine atasın ve yine "Sayfa3" deki alinin karşısındaki başka bir bilgiyi "A9" hücresine atasın. Teşekkürler

 

[Korhan Ayhan]

Selamlar,

"sayfa2" ve "sayfa3" sayfalarında "ali" verisi birden fazla olabiliyor mu?

 

[ates_2001]

Selamlar,

"sayfa2" ve "sayfa3" sayfalarında "ali" verisi birden fazla olabiliyor mu?

A.s Ayhan Bey bu zaten sizin yazdığınız formül, tekrardan elinize sağlık. evet birden fazla olabilir. Tekrardan Teşekkürler

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki şekilde kullanabilirsiniz.

Sub aktarim_yap()
    sat = 20
    With Sheets("Sayfa2").Range("B:B")
    Set c = .Find(Sheets("baslik").Range("D3"), LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
    ilkadres = c.Address
    Do
    Sheets("baslik").Cells(sat, "A") = Sheets("Sayfa2").Cells(c.Row, "C")
    
    sat = sat + 1
    Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> ilkadres
    End If
    End With
 
    sat = 9
    With Sheets("Sayfa3").Range("B:B")
    Set c = .Find(Sheets("baslik").Range("D3"), LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
    ilkadres = c.Address
    Do
    Sheets("baslik").Cells(sat, "A") = Sheets("Sayfa3").Cells(c.Row, "C")
    
    sat = sat + 1
    Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> ilkadres
    End If
    End With
End Sub

 

[ates_2001]

Teşekkürler, ellerinize sağlık