değişik yerlerde bulunan renkli hücreleri aktarma yapabilme..

[muratozmenler]

Ana sayfada bulunan kırmızı renkli verileri örnek:d2 kırmızı renkli ve bu veriyi sonuç sayfasına aktarırken sıralama b2-d2-e2-f2-g2-h2-ı2-l2-m2-n2 deki veriler ile sonuç sayfasına aktaracak tabi bu kırmızı olan her satırdaki hücre için geçerli. Kırmızı hücrelerin yeri değişebilir fakat aktarılacak veri aynı.
Ayrıca tekrar aktar dediğimizde sayfayı silecek ve verileri tekrardan sıralı olarak aktarıcak.

 

[hamitcan]

Sub aktar()
    For Each hcr In [a2:n44]
    If hcr.Interior.Color = vbRed Then
        i = i + 1
        Sheets("SONUÇ").Rows(i) = Rows(hcr.Row).Value
    End If
    Next
End Sub

 

[muratozmenler]

ilk olarak teşekkürler
birkaç sorum olacaktı peki aynı satırda birden fazla kırmızı renkli hücre varsa bu satırı sadece bir kez gösterebilirmi yani tekrarlamaması mümkünmü
ikinci olarak bazı tarihleri gün/ay/yıl bazılarını ay/gün/yıl olarak atıyor bunuda nasıl düzeltebiliriz
tekrardan teşekkürler...

 

[hamitcan]

Cevabı yarın verebileceğim, iyi akşamlar şimdilik.

 

[muratozmenler]

sizede iyi akşamlar dilerim...

 

[hamitcan]

Sadece "N" sütunu tarih içeriyor. Bu yüzden diğer sütunları ilgili sütun formatına çevirmelisiniz.

Sub aktar()
    For Each hcr In [a2:n44]
    If hcr.Interior.Color = vbRed Then
    If WorksheetFunction.CountIf(Sheets("SONUÇ").Columns(6), Cells(hcr.Row, "f")) = 0 Then
        i = i + 1
        Sheets("SONUÇ").Rows(i) = Rows(hcr.Row).Value
     End If
    End If
    Next
End Sub

 

[muratozmenler]

Teşekkür ederim sayın hamitcan
ama tarih formatına çevirdim ilgili sütunları fakat bu sefer hepsini ay/gün/yıl olarak atıyor yada yanlış birşeymi yapıyorum...?
Fazla olmaz isem birşey daha isteyecektim sayfaya veriyi atmadan önce a2:n45 aralığındaki veriyi temizleyebilirmi peki...

 

[muratozmenler]

sayın hamitcan vermiş olduğunuz cevaplar doğrultusunda kodları değiştirme yaparak ve bşrazda uzun bir kodlama yaparak birşeyler yapmaya çalıştım ve başardım fakat işlem uzun sürdüğü için kısaltma yapma gerek yardımcı olursanız sevinirim....

http://www.excel.web.tr/f14/bul-aktar-mukerrer-kay-t-sil-sayfay-onizle-t65920.html

 

[hamitcan]

Private Sub CommandButton1_Click()
With Sheets("SONUÇ")
 .[A2:N500].ClearContents
 For Each hcr In [a2:n44]
    If hcr.Interior.Color = vbYellow Then
    If WorksheetFunction.CountIf(.Columns(6), Cells(hcr.Row, "f")) = 0 Then
        i = i + 1
        .Rows(i) = Rows(hcr.Row).Value
     End If
    End If
 Next
    .Cells.Font.Size = 7
     Unload Me
    .PrintPreview
End With
End Sub