şartlı veri aktarımı

[drummers]

Sub dosyaaktar()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("data")
Set s2 = Sheets("Dosya")
s2.Range("B3:B46").Value = s1.Range("B2:B45").Value
s2.Range("D346").Value = s1.Range("Q2:Q45").Value


End Sub

sorum şudur: data ve dosya isimli 2 dosyam var. data' dan B2:B45 arasındaki hücrelerden verileri alıp dosya sekmesine yazmakta

fakat data sekmesindeki bazı hücrelerde ki yazılar kırmızı renkli ben bunları kopyalamasını istemiyorum

yani kırmızı yazılı olan veriler yok sayılıp ona göre aktarım yapılacak
bu konu hakkında yardımlarınız bekliyorum. kodu nasıl düzenliyebilirim.

 

[mustafaine1]

Kopyalandiktan sonra kirmizi renktekileri silmeni onersem..

 With Application.FindFormat.Font
        .Subscript = False
        .Color = 255
        .TintAndShade = 0
    End With
    Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=False

bu sekilde bi makro ile silebilirsin..

 

[drummers]

DATA daki kırmızı renkli veriler aynen kalacak sadece dosya sekmesine datadaki kırmızı renkliler kopyalanmıyacak

 

[mustafaine1]

tamam dosya sayfanizin vba sina kodu yazinca isinizi gormuyormu, isterseniz dosyanizi ekleyin daha duzgun bir sekilde anlayalim..

 

[drummers]

örnek dosya eklendi. içinede not yazdım

 

[mustafaine1]

Sub kirmizi_olmayanlari_aktar()
Dim s1 As Worksheet, s2 As Worksheet, i As Long
Set s1 = Sheets("data")
Set s2 = Sheets("Dosya")
For i = 2 To s1.Range("b2").End(4).Row
If s1.Cells(i, "b").Font.ColorIndex <> 3 Then
s2.Range("b65536").End(3)(2, 1).Value = s1.Cells(i, "b").Value
End If
Next i
Set s1 = Nothing: Set s2 = Nothing: i = Empty
End Sub

denermisin lutfen..

 

[drummers]

OLMADI

yada ben yapamadım

 

[mustafaine1]

Dosyadan dene birde..

 

[mustafaine1]

bu arada ben yandaki satirlara i j k yaparak donguleri almaya calistim ama calistiramadim dosya bolumunu 3 ayri sekilde ayirmaya gerek varmi, tek bolum olsa farkediyor mu?

 

[mustafaine1]

konu cozuldu.. Bu dosyanin son hali..