• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

renkli yazıları otomatik başka sayfadaki hücreye aktarmak.

Merhaba.
Aşağıdaki kodu deneyin.
Kod:
Sub Test()
    Dim syfDetay As Worksheet
    Dim syfHesap As Worksheet
    Dim Bak As Range
    Dim Say As Long
    Set syfDetay = Worksheets("Detay")
    Set syfHesap = Worksheets("Hesap")
    For Each Bak In syfDetay.Range("C1:C" & syfDetay.Cells(Rows.Count, "C").End(xlUp).Row)
        If Not Bak.Font.ColorIndex = 1 Then
            Say = syfHesap.Cells(Rows.Count, "B").End(xlUp).Row + 1
            If syfHesap.Range("B1") = "" Then Say = 1
            syfHesap.Range("B" & Say) = Bak
        End If
    Next
End Sub
 
Merhaba.
Aşağıdaki kodu deneyin.
Kod:
Sub Test()
    Dim syfDetay As Worksheet
    Dim syfHesap As Worksheet
    Dim Bak As Range
    Dim Say As Long
    Set syfDetay = Worksheets("Detay")
    Set syfHesap = Worksheets("Hesap")
    For Each Bak In syfDetay.Range("C1:C" & syfDetay.Cells(Rows.Count, "C").End(xlUp).Row)
        If Not Bak.Font.ColorIndex = 1 Then
            Say = syfHesap.Cells(Rows.Count, "B").End(xlUp).Row + 1
            If syfHesap.Range("B1") = "" Then Say = 1
            syfHesap.Range("B" & Say) = Bak
        End If
    Next
End Sub

çok güzel çalışıyor Değerli Muzaffer hocam elinize sağlık.
modül olarak butona koydum öyle çalıştı.otomatik her an çalışması için ne yapılması gerekiyor ?
birde eğer tabi zor değilse :) bulundukları satırın sırasıyla aynı sırada aktarılabilinirmi.misal detaydaki rengi değişen c4 deki hücre .hesap sayfasında b4 de gözüksün.

tabi bu halide çok işime yaradı çok çok teşekkür ederim Emeğinize sağlık.Sağlıcakla.
 
Geri
Üst