Soru Kod içeriği hakkında bilgi ?

[Yaren Eslem]

Sub aktar()
Dim sh As Worksheet, sat1 As Long, sat2 As Long, i As Long
Dim k As Range
Set sh = Sheets("Sayfa1")
Sheets("Sayfa2").Select
Range("C:E").Clear
sat1 = Cells(Rows.Count, "B").End(xlUp).Row
sat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To sat1
Set k = sh.Range("A2:A" & sat2).Find(Cells(i, "B").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
sh.Range("B" & k.Row & ":C" & k.Row).Copy Range("C" & i)
Set k = Nothing
End If
Next i
Set sh = Nothing
Application.ScreenUpdating = True

End Sub


Bu kodu kendime uyarlamaya çalışıyorum; renkli alanlardan ne anlamalıyım acaba?

Yardımlarınız için teşekkür ederim.

 

[Trilenium]

Set sh = Sheets("Sayfa1") << Sayfa1 artık sh adıyla anılacak diyoruz. SH değişkenine bağlamış oluyoruz.
Sheets("Sayfa2").Select << Sayfa2 yi seç diyoruz.
Range("C:E").Clear << sayfa2 seçildikten sonra C ve E sütun aralığındaki verileri temizle diyoruz.

sat1 = Cells(Rows.Count, "B").End(xlUp).Row << B kolonundaki son satır sayısını elde ediyoruz. ve bunu sat1 değişkenine atamış oluyoruz.
sat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row << A kolonundaki son satır sayısını elde ediyoruz. ve bunu sat2 değişkenine atamış oluyoruz.

sh.Range("A2:A" & sat2) << sayfa1 de A2 den başlayarak A kolonunun tamamında sat2 değişkeni kadar dönüp (Cells(i, "B").Value, satırlarında ara diyoruz.


sh.Range("B" & k.Row & ":C" & k.Row).Copy Range("C" & i) < sayfa 1 B ve C kolonlarında olanları kopyala C de bulunanlara yapıştır.

 

[Yaren Eslem]

İlginiz için çok teşekkür ederim, elinize sağlık... Dediğiniz gibi yaptım; fakat lakin ama, Range("C:E").Clear bu kod mevcut sayfadaki her şeyi silip süpürüyor.

 

[Yaren Eslem]

Örnek Dosyam

İlgilenenler için örnek dosya ekte, bu kodlar buraya uygulanacak.

Sub aktar()
Dim sh As Worksheet, sat1 As Long, sat2 As Long, i As Long
Dim k As Range
Set sh = Sheets("Sayfa1")
Sheets("Sayfa2").Select
Range("C:E").Clear
sat1 = Cells(Rows.Count, "B").End(xlUp).Row
sat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To sat1
Set k = sh.Range("A2:A" & sat2).Find(Cells(i, "B").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
sh.Range("B" & k.Row & ":C" & k.Row).Copy Range("C" & i)
Set k = Nothing
End If
Next i
Set sh = Nothing
Application.ScreenUpdating = True

End Sub

 

[Mdemir63]

Selamlar

doğru anladığımdan emin değilim.
inceleyiniz

 

[Trilenium]

İlginiz için çok teşekkür ederim, elinize sağlık... Dediğiniz gibi yaptım; fakat lakin ama, Range("C:E").Clear bu kod mevcut sayfadaki her şeyi silip süpürüyor.

Sayfayı silip süpüremez C,D,E aralığını temizler.

 

[Yaren Eslem]

Sayın, @Trilenium

Sayın, @Mdemir63

İlginize çok teşekkür ederim, ellerinize sağlık.

 

[Mdemir63]

Sayın, @Trilenium

Sayın, @Mdemir63

İlginize çok teşekkür ederim, ellerinize sağlık.

Rica ederim.
İyi çalışmalar