Makro ile hücreler arası koşullu kopyalama

[muratcx]

Merhaba arkadaşlar,

Çalışma sayfası içinde C ile I sütunu arasına başka sayfadan veriler gelecek, örnek dosyada görüleceği üzere veriler renkli alanlarda olacak. Renkli alandaki satır sayısı
değişken olacak, örneğin C6:I13 arası olacağı gibi C6:I25 de olabilir.

Kodun görevi ise renkli alandaki ilk satır boş değilse ilk satır ile son dolu satırı K:Q
hücrelerine kopyalamak.

Sırayla aşağıdaki renkli alanlarıda kopyalayacak ve her bir renkli alan için 1 satır boş bırakacak
Örnek dosyada mevcut durum ve olması gereken durum manuel olarak belirtilmiştir.

Yardımlarınızı rica ediyorum.

 

[Murat OSMA]

Şu kodları bir deneyiniz;

Sub Emre()
    Dim i As Integer
    Application.ScreenUpdating = False
    For i = Range("c65536").End(3).Row To 6 Step -1
        If IsEmpty(Cells(i, 3)) = True And _
        Cells(i, 3).Interior.ColorIndex <> 0 Then
            Rows(i).Delete
        End If
        If Cells(i, 3).Interior.ColorIndex <> Cells(i + 1, 3).Interior.ColorIndex Then
            Rows(i + 1).Insert Shift:=xlDown
        End If
    Next i
    Application.ScreenUpdating = True
    i = Empty
End Sub

 

[muratcx]

Teşekkür ederim eline sağlık.

 

[Murat OSMA]

Rica ederim, iyi akşamlar...