Tabloyu liste haline dökme

[Milady Meriç]

Herkese Selamlar;

"HESAPLAMA" isimli bir tabloda bulunan bilgileri, "SONUÇ" isimli bir sayfaya liste halinde göndermek istiyorum.
Commandbutton'a nasıl bir kod yazmalıyız?

İlgili örneği ve açıklamları ekte sunuyorum.

iyi çalışmalar dilerim.

 

[Necdet]

Merhaba,

Aşağıaki kodları bir modüle kopyalayın deneyiniz.

Sub Aktar()
    
    Dim Sat     As Long, _
        i       As Long, _
        Kol     As Integer, _
        SonKol  As Integer, _
        sh      As Worksheet, _
        ss      As Worksheet
    
    Set sh = Sheets("HESAPLAMA")
    Set ss = Sheets("SONUÇ")
    
    sh.Select
    Application.ScreenUpdating = False
    
    SonKol = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        
    MsgBox SonKol
    '---------------------------------------------------------------------------------
    ' SONUÇ sayfasına aktarmadan önce silinecekse aşağıdaki satırın çalışması gerekir
'     ss.Range("A:C").ClearContents
    '---------------------------------------------------------------------------------
    
    Sat = ss.Cells(Rows.Count, "A").End(3).Row
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        For Kol = 2 To SonKol
            If Not Cells(i, Kol) = 0 Then
                Sat = Sat + 1
                ss.Cells(Sat, "A") = Cells(i, "A")
                ss.Cells(Sat, "B") = Cells(i, Kol)
                ss.Cells(Sat, "C") = Cells(1, Kol)
            End If
        Next Kol
    Next i
    
    MsgBox "Aktarma Bitmiştir...", vbInformation, "N.YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub

 

[İhsan Tank]

Herkese Selamlar;

"HESAPLAMA" isimli bir tabloda bulunan bilgileri, "SONUÇ" isimli bir sayfaya liste halinde göndermek istiyorum.
Commandbutton'a nasıl bir kod yazmalıyız?

İlgili örneği ve açıklamları ekte sunuyorum.

iyi çalışmalar dilerim.

Merhaba
Alternatif olsun

Option Explicit
Sub listele_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi, asi
Set bordo = Sheets("HESAPLAMA")
Set mavi = Sheets("SONUÇ")
trabzonspor = MsgBox("Listeleme Yapıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
mavi.Range("A:C").ClearContents
kaplan = 1
For ts = 2 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
For asi = 2 To bordo.Cells(1, Columns.Count).End(xlToLeft).Column
If bordo.Cells(ts, asi) <> 0 Then
mavi.Cells(kaplan, "A") = bordo.Cells(ts, "A")
mavi.Cells(kaplan, "B") = bordo.Cells(ts, asi)
mavi.Cells(kaplan, "C") = bordo.Cells(1, asi)
kaplan = kaplan + 1
End If
Next
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Listeleme Yapıldı", , "Bitiş"
End Sub

 

[Milady Meriç]

Sizlere nasıl teşekkür edeceğimi bilemiyorum.

Allah razı olsun ne diyeyim.