Yan yana sütunları alt alta sıralama

[Serdarrk]

Merhaba,

Ekli dosyadaki gibi dosyalarda Sayfa1'de yan yana bulunan verileri Sayfa2'deki gibi en sondaki 2017 sütununun altına en son 1999 sütunu olacak şekilde sıralamak istiyorum. Bunun bir kısayolu var mıdır?


http://s7.dosya.tc/server4/9rk1ej/asdsacsa.xls.html

 

[Ziynettin]

Merhaba,

Yıllar tablodaki gibi olduğunda aşağıdaki kod sanırım işinizi görür.

Sub deneme()
son = Range("A:BW").Find("*", , , , xlByRows, xlPrevious).Row
a = Range("A1:BW" & son)
For j = UBound(a, 2) To 1 Step -4
    For i = 1 To UBound(a)
        If a(i, j) <> "" Then
            satir = satir + 1
        End If
    Next i
Next j

ReDim b(1 To satir, 1 To 3)
For j = UBound(a, 2) To 1 Step -4
    For i = 1 To UBound(a)
        If a(i, j) <> "" Then
            say = say + 1
            b(say, 1) = a(i, j - 2)
            b(say, 2) = a(i, j - 1)
            b(say, 3) = a(i, j)
        End If
    Next i
Next j

Sheets("sayfa2").Range("A1").Resize(say, 3) = b
MsgBox "İşlem bitti...", vbInformation
End Sub

 

[Serdarrk]

Mükemmel çalışıyor. İlginize ve emeğinize çok teşekkür ederim.

 

[canigdeli]

Merhaba,

Yıllar tablodaki gibi olduğunda aşağıdaki kod sanırım işinizi görür.

Sub deneme()
son = Range("A:BW").Find("*", , , , xlByRows, xlPrevious).Row
a = Range("A1:BW" & son)
For j = UBound(a, 2) To 1 Step -4
    For i = 1 To UBound(a)
        If a(i, j) <> "" Then
            satir = satir + 1
        End If
    Next i
Next j

ReDim b(1 To satir, 1 To 3)
For j = UBound(a, 2) To 1 Step -4
    For i = 1 To UBound(a)
        If a(i, j) <> "" Then
            say = say + 1
            b(say, 1) = a(i, j - 2)
            b(say, 2) = a(i, j - 1)
            b(say, 3) = a(i, j)
        End If
    Next i
Next j

Sheets("sayfa2").Range("A1").Resize(say, 3) = b
MsgBox "İşlem bitti...", vbInformation
End Sub

Merhaba benzer bir çalışma için yardımınıza ihtiyacım var ancak formulün hangi kısmında excel çalışmama göre değişiklik yapmam gerekir çözemedim destek olur musunuz?