Veriler Sayfasını İstenilen Şekliyle Düzenleme

[Datalay]

Merhabalar,

Karma verilerin bulunduğu sayfada,
- İstenilen ifadenin bulunduğu sütun dışındaki sütunları silmesini,
- Boş satırların silinmesini
- Her sütuna ait genişliklerin farklı ölçülerde belirlenip uygulanması,
- Tüm satırların genişliklerinin belirlenmesi (sabit, mesela 35)
- Listenin tamamına kenarlık eklemek.

Not: Forumu yeni kayıt oldum ve örnek dosya ekleme seçeneğini bulamadım. Resim şeklinde aşağıda belirttim.

Bunları yapacak makroya ihtiyacım var. Yardımcı olanlara şimdiden çok çok teşekkür ederim.
Kolay gelsin.

Veri Hali,

İstenilen Sonuç,

 

[alicimri]

Resimdeki örneğinize göre kodları yazdım. Kendinize uyarlayın

Sub duzenle()
'Veri sayfasındaki bilgiler Sonuç sayfasına alınıyor.
Sheets("Veri").Cells.Copy Sheets("Sonuç").Cells
Sheets("Sonuç").Select
'4. satırdaki başlıkların en son (En sağdaki) başlığın sütun numarası bulunuyor
say = Cells(4, Columns.Count).End(1).Column
' En sondaki sütundan başlayarak 4. satırdaki ilk 6 harfi "Başlık" ve Hücre art alanı sarı olan sütunların dışındaki sütunlar siliniyor.
For i = say To 1 Step -1
If Cells(4, i).Interior.ColorIndex = 6 And Left(Cells(4, i), 6) = "Başlık" Then
Else
Columns(i).Delete
End If
Next
'En alttaki satır numarası bulunuyor.
say1 = Range("A65536").End(3).Row
En alttaki satırdan başlayarak yukarıya doğru tüm satır ""  ise (boşsa) siliniyor.
For e = say1 To 1 Step -1
If WorksheetFunction.CountIf(Range(Cells(e, 1), Cells(e, Columns.Count)), "") = Columns.Count Then
Rows(e).Delete
End If
Next
' Silindikten sonraki kalan tüm  dolu hücreler seçiliyor.
Range("a1").CurrentRegion.Select
' Sütun genişliği 35 yapılıyor.
 Selection.ColumnWidth = 35
'Kenarlıklar çiziliyor
  With Selection.Borders
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
End Sub

 

[alicimri]

Yukardaki kodları Ofis 2003 e uygun yapmıştım. Onu düzelttim ve açıklamalar ekledim.

 

[Datalay]

Teşekkür ederim, elinize sağlık.