Listeyi yatay yazdırma makrosu

[excel12312]

Selamlar ,

Ekte paylaştığım dosyada veri ve özet diye 2 sayfa var. Veri sayfasındaki listede enine sıralanmış veriler ver ve aralarında boşluklar var. Makro ile bu verileri arada boşluk olmadan özet sayfasındaki listeye yazdırmak istiyorum. ( listedeki veriler temsili olup satırları ve sutünları artabilir ) Desteğiniz için şimdiden teşekkürler.

iyi çalışmalar.

 

[çıtır]

Özet sayfası B3 hücresine kopyalayınız.Sağa ve aşağı çekerek çoğaltınız.

=EĞERHATA(İNDİS(VERİ!$A3:$Z3;TOPLAMA(15;6;(SÜTUN($B3:$Z3)/(VERİ!$B3:$Z3<>""));SÜTUN(A1)));"")

 

[excel12312]

Teşekkürler cevabınız için , peki bunu makro ile nasıl yazabilirim. belirli bir aralık için ? Verilerin bulunduğu sayfa her seferinde yeniden oluştuğu için yazdığım formül kalıcı olmuyor.

teşekkürler.

 

[çıtır]

Umarım işinize yarar.Formüllü dilediğiniz kadar uzatarak isteğinizi gerçekleştirebilirdiniz.

Sub yatay()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim i As Integer
Dim y As Integer
Set s1 = Sheets("VERİ")
Set s2 = Sheets("ÖZET")
Application.ScreenUpdating = False
s1.Select
son = s1.Cells(65536, "B").End(3).Row
süt = s1.Cells.SpecialCells(xlCellTypeLastCell).Column
s2.Select
son2 = s2.Cells(65536, "B").End(3).Row
süt2 = s2.Cells.SpecialCells(xlCellTypeLastCell).Column

s2.Range(s2.Cells(3, 2), s2.Cells(son2, süt2)).Select
Selection.ClearContents
al = 2
sat = 3
For y = 3 To son
For i = 2 To süt + 2
If s1.Cells(sat, i) <> "" Then
s2.Cells(y, al) = s1.Cells(y, i)
al = al + 1
End If
Next i
sat = sat + 1
al = 2
Next y
s2.Range("B2").Select
Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAM", vbInformation, "BİLGİ"
End Sub

 

[anemis]

Sayın çıtır;


İnanın kitap niteliğinde olmuş hem formül hem yazdığınız kod için teşekkürler. Bana da çok faydalı oldu. elinize sağlık


...

 

[çıtır]

Sayın çıtır;


İnanın kitap niteliğinde olmuş hem formül hem yazdığınız kod için teşekkürler. Bana da çok faydalı oldu. elinize sağlık


...

Ben teşekkür ederim Sayın anemis tüm arkadaşlarının cevaplarından bende çok istifade ediyorum.