- Katılım
- 26 Ocak 2007
- Mesajlar
- 4,625
- Excel Vers. ve Dili
- Ofis 2016
- Altın Üyelik Bitiş Tarihi
- 20-02-2025
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub renk()
Dim i As Range, r As Byte, son As Long
son = Cells(Rows.Count, "C").End(xlUp).Row
Range("C3:C" & Rows.Count).Interior.ColorIndex = 0
For Each i In Range("D3:F" & son)
If i.Interior.ColorIndex > 0 Then
r = i.Interior.ColorIndex
Cells(i.Row, "C").Interior.ColorIndex = r
End If
Next i
End Sub
Ömer üstadım, çok teşekkür ediyorum. Emeğinize aklınıza sağlık. sağlıcakla kalınMerhaba
Deneyiniz.
Kod:Sub renk() Dim i As Range, r As Byte, son As Long son = Cells(Rows.Count, "C").End(xlUp).Row Range("C3:C" & Rows.Count).Interior.ColorIndex = 0 For Each i In Range("D3:F" & son) If i.Interior.ColorIndex > 0 Then r = i.Interior.ColorIndex Cells(i.Row, "C").Interior.ColorIndex = r End If Next i End Sub
Sub RenkleriKopyala()
Dim ws As Worksheet
Dim i As Long
Dim kaynakHücre As Range
Dim hedefAralik As Range
Set ws = ThisWorkbook.Sheets("Sayfa1")
For i = 10 To 40
Set kaynakHücre = ws.Range("A" & i)
Set hedefAralik = ws.Range("B" & i & ":T" & i)
If Not IsEmpty(kaynakHücre) Then
hedefAralik.Interior.Color = kaynakHücre.Interior.Color
End If
Next i
MsgBox "Renkler başarıyla kopyalandı!"
End Sub