Sütunları Alt Alta Yazdırmak

Katılım
15 Ağustos 2016
Mesajlar
11
Excel Vers. ve Dili
2016
Merhaba
Linkte verdiğim örnek excelimdeki gibi sütunlardaki sayıları (bkz Sheet1) alt alta toplamak istiyorum.
Ben Sheet2 de manuel olarak yaptim ama sütün ve satırlar cok fazla olacak, otomatik yaptırmam lazım

Yardımcı olacaklara şimdiden teşekkürler

Örnek Excelim
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
28,816
Excel Vers. ve Dili
OFFICE 2019 PRO TR
Deneyiniz.

C++:
Option Explicit

Sub Sutunlari_Alt_Alta_Listele()
    Dim S1 As Worksheet, S2 As Worksheet, Veri As Variant
    Dim Son_Satir As Long, Son_Sutun As Integer
    Dim X As Long, Y As Integer, Say As Long, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
    
    S2.Range("A:A").Clear
    
    Son_Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Son_Sutun = S1.Cells(1, S1.Columns.Count).End(1).Column
    
    Veri = S1.Range("B2:" & S1.Cells(Son_Satir, Son_Sutun).Address(0, 0)).Value
    
    ReDim Liste(1 To Son_Satir * Son_Sutun, 1 To 1)
    
    For Y = LBound(Veri, 2) To UBound(Veri, 2)
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            If Veri(X, Y) <> "" Then
                Say = Say + 1
                Liste(Say, 1) = Veri(X, Y)
            End If
        Next
    Next

    S2.Range("A1").Resize(Say) = Liste

    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
Üst