Tablodaki verileri satıra döndürme

[bebar]

Merhaba,

Tablodaki verilerimi satıra çevirmek istiyorum ama bir türlü yapamadım yardımcı olursanız çok memnun olurum dosyam ektedir.

teşekkür ederim.

 

[Ömer]

Merhaba,

Eki inceleyin. Düzenle butonu ile verileriniz Sayfa2 ye istediğiniz formatta listeler.
Detaylı deneme yapmadım. Hatalı listeleme varsa hatayı örneklendirerek açıklamanızı rica ederim.

http://s5.dosya.tc/server4/55nksc/ornek.rar.html

.

 

[bebar]

hocam çok ama çok teşekkür ederim çok faydası oldu.

 

[Ömer]

Rica ederim. Güle güle kullanın.

.

 

[askm]

Bende hazırlamıştım. Alternatif olarak kodları aşağıdadır. Sayfa2 yi yoksa kendi oluşturuyor.

Sub ASKM_Aktar()
Dim s1, s2 As Worksheet
Dim bulundu As Boolean
Set s1 = Sheets("Sayfa1")
Application.ScreenUpdating = False
For i = 1 To Worksheets.Count
If CStr(Sheets(i).Name) = "Sayfa2" Then
    bulundu = True
    Set s2 = Sheets("Sayfa2")
End If
Next i
If bulundu = False Then
    Sheets.Add After:=Sheets(Worksheets.Count)
    ActiveSheet.Name = "Sayfa2"
    Set s2 = Sheets("Sayfa2")
End If

Dim SonSat As Long
s2.Cells.ClearContents
SonSat = s1.Range("A14").End(xlDown).Row
s2.Cells(1, 1) = "Mağaza Kodu"
s2.Cells(1, 3) = "Model Kodu"
s2.Cells(1, 4) = "Renk Kodu"
s2.Cells(1, 5) = "Beden"
s2.Cells(1, 6) = "Adet"
Columns("A:A").ColumnWidth = 20
Columns("B:F").ColumnWidth = 12
s2.Rows(1).Font.Bold = True
s2.Rows(1).Font.Underline = xlUnderlineStyleSingle
x = 2
For Satir = 15 To SonSat
    For Sutun = 4 To 18
        If s1.Cells(Satir, Sutun) <> "" Then
        If s1.Cells(1, Sutun) <> "" Then
            Model = s1.Cells(1, Sutun).Column
        End If
            s2.Cells(x, 1) = s1.Cells(Satir, 1)
            s2.Cells(x, 3) = s1.Cells(1, Model)
            s2.Cells(x, 4) = s1.Cells(4, Model)
            s2.Cells(x, 5) = s1.Cells(9, Sutun)
            s2.Cells(x, 6) = s1.Cells(Satir, Sutun)
            x = x + 1
        End If
    Next Sutun
Next Satir
Application.ScreenUpdating = True
MsgBox "Aktarma işlemi tamamlanmıştır.", vbInformation, "ASKM"
End Sub

 

[Asri]

Bir alternatif de bende olsun

Sütun ve satırlar arttırılıp azaltılabilir.
Bedenler arttırılıp azaltılabilir.

http://dosya.co/hmxxxvdekr2w/Tablodan_Liste_Olustur.xlsm.html

Sub tablodan_satira()
   Set shliste = Sheets("Liste")
   Set shtablo = Sheets("Tablo")
   sonsutun = shtablo.Cells(9, Columns.Count).End(xlToLeft).Column
   sonsatir = shtablo.Cells(Rows.Count, "A").End(3).Row
   listeson = shliste.Cells(Rows.Count, "A").End(3).Row + 1
   shliste.Range("A2:F" & listeson).Clear
   
   For i = 15 To sonsatir
     tablomagaza = shtablo.Cells(i, "A").Value
     listeson = shliste.Cells(Rows.Count, "A").End(3).Row + 1
     For i2 = 4 To sonsutun
        If shtablo.Cells(1, i2).Value <> "" Then tablomodel = shtablo.Cells(1, i2).Value
        If shtablo.Cells(4, i2).Value <> "" Then tablorenkkodu = shtablo.Cells(4, i2).Value
        shliste.Cells(listeson, 1).Value = shtablo.Cells(i, "A").Value
        shliste.Cells(listeson, 3).Value = "'" & tablomodel
        shliste.Cells(listeson, 4).Value = "'" & tablorenkkodu
        shliste.Cells(listeson, 5).Value = shtablo.Cells(9, i2).Value
        shliste.Cells(listeson, 6).Value = shtablo.Cells(i, i2).Value
        listeson = listeson + 1
     Next i2
   Next i
   MsgBox ("Liste oluşturuldu")
End Sub