• DİKKAT

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

Genel Biçimlendirme

Katılım
18 Kasım 2012
Mesajlar
33
Excel Vers. ve Dili
Excel 2010 - İngilizce
Merhaba,

Aşağıdaki kodu yazdım. Buna göre Sheet1 deki verilere bağlı olarak Sheet 2 ye listeleme yapıyorum. Ancak makro çalıştığında sheet 2 ye yapılan listenin A ve B sütunlarında format farklı diğer sütunlarda format farklı. (yazı Tipi, boyutu, kenarlıklar vs.)

Bu kodun içine ilk satır hücre rengini mavi, font rengini beyaz, font tipini arial yapıp, diğer tüm satırların hücre rengini beyaz, font rengini siyah ve font tipini calibri yapacak kodu nasıl ekleyebiliriz? (kenarlık da olmamalı hiç bir hücrede)

Şimdiden teşekkürler.


Kod:
Sub Listele()
 
    Dim Sd As Worksheet, i As Byte, c As Range, Adr As Variant, sat As Long
 
    Set Sd = Sheets("Sheet1")
    
    Application.ScreenUpdating = False
    Sheets("Sheet2").Select
    Range("A2:B" & Rows.Count).Clear
 
    For i = 1 To 10
        sat = 2
        With Sd.Range("I:I")
            Set c = .Find(Cells(1, i), , xlValues, xlWhole)
            If Not c Is Nothing Then
              Adr = c.Address
                Do
                    If Sd.Cells(c.Row, "C") & "|" & Sd.Cells(c.Row, "D") = "3|2013" Then
                        Cells(sat, i) = Sd.Cells(c.Row, "A")
                        sat = sat + 1
                    End If
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End With
    Next i
 
    Application.ScreenUpdating = True
 
 End Sub
 
makro kaydet yöntemi ile bu kodu buldum işinize yararsa kullanın

Kod:
Sub makro3()
 
 
    Cells.Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Font.ColorIndex = 0
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A1:D1").Select
    With Selection.Interior
        .ColorIndex = 5
        .Pattern = xlSolid
    End With
    Selection.Font.ColorIndex = 2
    Range("A1").Select
End Sub
 
Çok teşekkürler
 
Geri
Üst