Diğer sayfaya aktarılması hakkında

[1903emre34@gmail.com]

Merhaba,

Her birinden farklı madde numaralarda kayıtlar bulunmaktadır, istenen hesapları bulunduğu takdirde diğer sayfaya aktarılmasi için kod oluşturabilir miyiz

 

[Asri]

Aşağıdaki şekilde deneyiniz. Madde numaraları dikkate alınmamıştır.
Kırmızı çizgi madde grubu olarak düşünüldü.

Sub Hesap_Ayir()
   Set sh1 = Sheets("Sayfa1")
   Set Sh2 = Sheets("Sayfa2")
   
   Sh2.Cells.Clear
   sonsatir = sh1.Cells(Rows.Count, "A").End(3).Row + 1
   buldu281 = False
   buldu700 = False
   basla = 1
   satir = 1
   For i = 2 To sonsatir
      hesap = sh1.Cells(i, "C").Value
      madde = sh1.Cells(i, "B").Value
      If hesap = 281 Then buldu281 = True
      If hesap = 700 Then buldu700 = True
      If sh1.Cells(i, "B").Interior.Color = 255 Then
         If buldu281 And buldu700 Then
            bitir = i - 1
            sh1.Rows(basla & ":" & bitir).Copy Sh2.Range("A" & satir)
            satir = bitir + 2
         End If
         buldu281 = False
         buldu700 = False
         basla = i + 1
      End If
   Next i
   
End Sub