Mağaza Listesini Çarşaf liste yapma

[eceLprensi]

Merhaba,
Üstatlarım,

Ekteki tablodaki gibi mağaza listeleri yanyana olarak bulunuyor.
Bunları alt alta almak istiyorum.
makro sanki daha hızlı çözüm sağlar.
Teşekkürler.

 

[veyselemre]

Sub test()
    Dim s1 As Worksheet, veriler, sat&, i&, ii%, iii%
    Set s1 = Sheets("Sayfa1")
    veriler = s1.Range("A1:Q" & s1.Cells(Rows.Count, 1).End(3).Row).Value
    With Sheets("Sayfa2")
        .Range("A2:O" & Rows.Count).ClearContents
        sat = 2
        For i = 14 To 17
            For ii = 2 To UBound(veriler)
                If veriler(ii, i) > 0 Then
                    .Cells(sat, 1).Value = veriler(1, i)
                    For iii = 1 To 13
                        .Cells(sat, iii + 1).Value = veriler(ii, iii)
                    Next iii
                    .Cells(sat, 15).Value = veriler(ii, i)
                    sat = sat + 1
                End If
            Next ii
        Next i
    End With
End Sub

 

[eceLprensi]

Üstadım ellerine emeklerine sağlık,
Mağaza sayısını bana sorması mümkünmü
Mağaza Sayısı Gir: 15 Gibi