tüm sayfadaki veriyi tek satırda sıralama

[alptekinn]

yan yana satırlara girilmiş verilerden oluşan bir tabloyu alt alta tek bir tablo halinde toparlamak istiyorum. bunu nasıl yapabilirim? Bir de bunu tek seferlik bir kes-yapıştır olarak değil de veriler değişse de otomatik olarak yapmak istiyorum.

normalde üzerinde çalıştığım sayfada çok daha fazla veri olduğu için böyle bir örnek tablo oluşturdum.

sayfa 1 görüntüsü bu olacak.


isim1 - sayı1 - isim2 - sayı2 - isim3 - sayı3

ali - 2 - ahmet - 3 - ayşe - 7
veli - 3 - mehmet - 7 - zeynep - 8
hasan - 4 - hüseyin - 1 - metin - 3
fatma - 8 - hayriye - 3 - can - 5

-------------------------------------------------------------------------------




sayfa2 de ben bu veriyi bu şekilde toparlamak istiyorum. sayfa 1 deki veri değiştiğinde bu sayfaya o değişikliğin otomatik olarak yansımasını istiyorum.


isim 1 - sayı 1
ali 2
veli 3
hasan 4
fatma 8
ahmet 3
mehmet 7
hüseyin 1
hayriye 3
ayşe 7
zeynep 8
metin 3
can 5



Veriyi yorumlayabilmek için alt alta sıralamalıyım ama bir türlü beceremedim. Yardımcı olursanız sevinirim.



orijinal dosyaya şu adresten ulaşabilirsiniz:
http://s3.dosya.tc/server7/bdyiqm/metin_analizi.xlsx.html

sayfa10- veri sayfası
sayfa11- analizin yapılacağı sayfa

 

[Korhan Ayhan]

Makro ile hızlı bir şekilde aktarabilirsiniz.

Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Son_Satir As Long, Son_Sutun As Integer
    Dim X As Long, Y As Integer, Satir As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set S1 = Sheets("Sayfa10")
    Set S2 = Sheets("Sayfa11")
    
    S2.Range("B2:C" & S2.Rows.Count).ClearContents
    Son_Satir = S1.Cells(S1.Rows.Count, 2).End(3).Row
    Son_Sutun = S1.Cells(2, S1.Columns.Count).End(1).Column
    Satir = 2
    
    For X = 4 To Son_Satir
        For Y = 3 To Son_Sutun Step 2
            If S1.Cells(X, Y) <> 0 Then
                S2.Cells(Satir, 2) = S1.Cells(X, Y)
                S2.Cells(Satir, 3) = S1.Cells(X, Y + 1)
                Satir = Satir + 1
            End If
        Next
    Next
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub