hücre aralığı seçtirme

[tahirturan]

Merhaba,

Elimdeki bir makro şu şekilde işlem yapıyor;

B sütunundaki verileri A sütunundakilerle kıyaslayıp A da olanları C ye, tam karşısına yazıyor. Bununla ilgili eylemi gerçekleştiren kod ise şu şekilde:

Sub eslestir()
Dim i As Long, sat As Long
Sheets("YOL").Select
For i = 1 To Cells(65536, "A").End(xlUp).Row
If Cells(i, "A").Value <> "" Then
Set k = Range("B1:B65536").Find(Cells(i, "A").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
Cells(k.Row, "B").Cut
Cells(i, "C").Select
ActiveSheet.Paste
End If
End If
Next
Application.CutCopyMode = False
MsgBox "İşlem tamamlandı.", vbOKOnly + vbInformation
End Sub

Benim yapmak istediğim ise şu;

B yi A ya göre kıyaslasın aynı şekilde. Fakat dizilimi bozmadan B-C-D hücrelerini F-G-H hücrelerine taşısın. Bu veri koordinat verisi olduğu için XYZ üçlüsünün bozulmaması gerekiyor.

Yardımcı olur musunuz?

 

[Orion1]

Sub eslestir()
Dim i As Long, sat As Long
Sheets("YOL").Select
For i = 1 To Cells(65536, "A").End(xlUp).Row
If Cells(i, "A").Value <> "" Then
Set k = Range("B1:B65536").Find(Cells(i, "A").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
[B][COLOR="Red"]Range("B" & k.Row & ":D" & k.Row).Cut
Cells(i, "F").Select[/COLOR][/B]
ActiveSheet.Paste
End If
End If
Next
Application.CutCopyMode = False
MsgBox "İşlem tamamlandı.", vbOKOnly + vbInformation
End Sub

 

[tahirturan]

çok teşekkür ederim. istediğim tam olarak buydu.

 

[Orion1]

çok teşekkür ederim. istediğim tam olarak buydu.

Rica ederim.
İyi çalışmalar.