Alt Alta Satırları Sütunlara Sıralamak

[selami1982]

Arkadaşlar günaydın,

Elimde çok satırlı bir veri var, bunları her şube için yan yana sıralamak istiyorum. Manuel yapmak çok fazla zaman alıyor. Bunu nasıl otomatik bir hale getirebiliriz?

Ekte dosyayı paylaşmış bulunmaktayım.

İyi çalışmalar dilerim.

SAMPLE.xlsx dosyasını indir - download

SAMPLE.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

 

[muysun35]

Arkadaşlar günaydın,

Elimde çok satırlı bir veri var, bunları her şube için yan yana sıralamak istiyorum. Manuel yapmak çok fazla zaman alıyor. Bunu nasıl otomatik bir hale getirebiliriz?

Ekte dosyayı paylaşmış bulunmaktayım.

İyi çalışmalar dilerim.

SAMPLE.xlsx dosyasını indir - download

SAMPLE.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

Aradığınız böyle bir şey mi?

Alt alta veriyi yanyana Dizme Makrosu

Herkese selamlar. örnek dosyaya bir gözatıp yardımcı olabilecek arkadaşlar büyük sevaba girerler.. ilk 50 - 60 satır manuel olarak yapıldı. kalan 8000 satır için yardım ederseniz....

www.excel.web.tr

 

[selami1982]

Oradaki dosya linki silinmiş örneği göremedim. Örnek dosyayı eklemiştim esasında iletiye.

a
1
2
3
4
5
6


Düzenindeki verilerin A altında
123
456 şekline gelmesini istiyorum ancak ekte attığım çok katmanlı olduğu için transpose ile mümkün olmuyor.

 

[Korhan Ayhan]

Merhaba,

Paylaştığınız dosyanızda ham hali bu ben bu şekle dönüşmesini istiyorum şeklinde örneklendirirseniz konu daha net anlaşılacaktır.

 

[selami1982]

Haklısınız, ekteki dosyaya hem ilk halini hem de elde etmek istediğim halini paylaştım.
Makrolu ya da makrosuz nasıl bir çözüm bulabiliriz paylaşırsanız sevinirim.

SAMPLE.xlsx dosyasını indir - download

SAMPLE.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

 

[Korhan Ayhan]

Merhaba,

Biçimleri hariç aktarım için deneyiniz.

Kod aynı sayfanın "K" sütunundan itibaren yeni düzenlenmiş listeyi aktarır.

Option Explicit

Sub Verileri_Duzenle()
    Dim Zaman As Double, S1 As Worksheet, Y As Byte
    Dim Son As Long, Veri As Variant, X As Long, Say As Long
    
    Zaman = Timer
    
    Set S1 = Sheets("Sayfa1")
    
    S1.Range("K:Y").Clear
    
    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
    If Son = 1 Then Son = 2
    
    Veri = S1.Range("B1:G" & Son).Value
    
    ReDim Liste(1 To Son, 1 To 15)
    
    For X = LBound(Veri) To UBound(Veri)
        If X = 1 Then
            Say = Say + 1
            Liste(Say, 1) = Veri(X, 1)
            Liste(Say, 2) = Veri(X, 2)
            Liste(Say, 3) = Veri(X, 3)
            Liste(Say, 4) = Veri(X, 4)
            Liste(Say, 8) = Veri(X, 5)
            Liste(Say, 12) = Veri(X, 6)
            GoTo 10
        End If
        
        For Y = 1 To 3
            Say = Say + 1
            Select Case Y
                Case 1
                    Liste(Say, 1) = Veri(Say, 1)
                    Liste(Say, 2) = Veri(Say, 2)
                    Liste(Say, 3) = Veri(Say, 3)
                    Liste(Say, 4) = Veri(Say, 4)
                    Liste(Say, 5) = Veri(Say, 4)
                
                    Liste(Say, 6) = Veri(Say + 1, 4)
                    Liste(Say, 7) = Veri(Say + 2, 4)
                    
                    Liste(Say, 8) = Veri(Say, 5)
                    Liste(Say, 9) = Veri(Say, 5)
                    Liste(Say, 10) = Veri(Say + 1, 5)
                    Liste(Say, 11) = Veri(Say + 2, 5)
                    
                    Liste(Say, 12) = Veri(Say, 6)
                    Liste(Say, 13) = Veri(Say, 6)
                    Liste(Say, 14) = Veri(Say + 1, 6)
                    Liste(Say, 15) = Veri(Say + 2, 6)
                
                Case 2, 3
                    Liste(Say, 1) = Veri(Say, 1)
                    Liste(Say, 2) = Veri(Say, 2)
                    Liste(Say, 3) = Veri(Say, 3)
                    Liste(Say, 4) = Veri(Say, 4)
                    Liste(Say, 5) = ""
                
                    Liste(Say, 6) = ""
                    Liste(Say, 7) = ""
                    
                    Liste(Say, 8) = Veri(Say, 5)
                    Liste(Say, 9) = ""
                    Liste(Say, 10) = ""
                    Liste(Say, 11) = ""
                    
                    Liste(Say, 12) = Veri(Say, 6)
                    Liste(Say, 13) = ""
                    Liste(Say, 14) = ""
                    Liste(Say, 15) = ""
                    If Y = 3 Then X = X + 2
            End Select
        Next
10  Next
    
    S1.Range("K1").Resize(UBound(Liste, 1), UBound(Liste, 2)) = Liste
    S1.Columns.AutoFit

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