Soru Excelde Şartlı satır taşıma.

[muygun]

Merhaba;
Yine bir çelişki var...
DAĞITIM CETVELİ sayfasında;
D sütunu kadastro bölümünde =Ada/Par
W sütunu İmar bölümünde =Ada/Par
Yani bu iki sütun verisine bakılarak,

HESAPLAMA sayfasında;
D sütunu eşdeğeri Hesaplama sayfasında D sütunu,
W sütunu eşdeğeri Hesaplama sayfasında ? sütunu...

Bundan dolayı makroda;
D&E sütun bileşenini (her iki sayfada da bu veri mevcut) arattırıp sayfaya yerleştirdim.
Bundan sonrası size kalmış. (yeterince net yardım alamadığım için çözüm bulamıyorum.)
İyi çalışmalar.

Sub imar_alanını_getir()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("DAĞITIM CETVELİ")
Set s2 = ThisWorkbook.Worksheets("HESAPLAMA")
s1.Range("ad1:ad65536").ClearContents
s2.Range("o4:ac65536").ClearContents
s2.Range("o4:ac65536").Borders.LineStyle = xlNone

For i = 4 To s1.Range("c65536").End(xlUp).Row
s1.Cells(i, "ad") = s1.Cells(i, "d") & s1.Cells(i, "e")
Next i
sonn = s1.Range("ad65536").End(xlUp).Row
For i = 4 To s2.Range("d65536").End(xlUp).Row
aranan = "": sırası = 0
aranan = s2.Cells(i, "d") & s2.Cells(i, "e")
sırası = WorksheetFunction.Match(aranan, s1.Range("ad1:ad" & sonn), 0)
If sırası >= 4 Then
For k = 15 To 29
s2.Cells(i, k) = s1.Cells(sırası, k)
Next k
End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub