Soru Dikey listeleri yataya çevirme

[lovecaroline]

Makro ile ekteki listede yer ilk sayfadaki gibi bir liste ikinci sayfadaki hale getirebilir mi?
Şimdiden teşekkürler.

 

[lovecaroline]

Listeler uzun olabilir. Yatay olarak sağ tarafa doğru listelensin istiyorum. Tekrardan teşekkürler.

 

[Orion1]

Buyurun.

Sub yatay()
Dim i As Long, sut As Integer, sat As Long
Dim sh As Worksheet
Sheets("Soru").Select
Set sh = Sheets("isteğim")
sh.Range("A1:Z" & Rows.Count).ClearContents
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    If Range("A" & i).Font.Bold Then
        sut = sut + 1
        sat = 1
        sh.Cells(sat, sut).Value = Cells(i, "A").Value
        sh.Cells(sat, sut).Font.Bold = True
    Else
        sat = sat + 1
        sh.Cells(sat, sut).Value = Cells(i, "A").Value
    End If
Next
sh.Select
MsgBox "Bitti"
End Sub

 

[Korhan Ayhan]

Alternatif;

Option Explicit

Sub Transpose_Aktar()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Say As Long
    Dim Veri As Variant, X As Long, Aranan As Range, Bul As Range
    
    Set S1 = Sheets("soru")
    Set S2 = Sheets("isteğim")
    
    S2.Cells.Clear
    
    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
    If Son < 3 Then Son = 3
    
    Veri = S1.Range("B2:B" & Son).Value
    
    With CreateObject("Scripting.Dictionary")
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            If Not .Exists(Veri(X, 1)) Then
                .Add Veri(X, 1), Nothing
            End If
        Next
        
        S2.Range("A1").Resize(, .Count) = .Keys
    End With
    
    For Each Aranan In S2.Range("A1").CurrentRegion
        Set Bul = S1.Range("B:B").Find(Aranan.Value, , , xlWhole)
        If Not Bul Is Nothing Then
            Say = WorksheetFunction.CountIf(S1.Range("B:B"), Aranan.Value)
            Aranan.Offset(1).Resize(Say).Value = S1.Range("C" & Bul.Row & ":C" & Bul.Row + Say - 1).Value
        End If
    Next

    S2.Select
    
    Set Bul = Nothing
    Set S1 = Nothing
    Set S2 = Nothing

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub