Sütunlarda yer alan veriyi satırlara yazmak

[aydinsert]

Herkese merhabalar,
Kısaca sorum şu şekilde: Satır ve sütunlara dağılmış veriyi yani sağa doğru uzayan veriyi belli kural dahilinde aşağıya doğru formülle veya vba ile yazdırmak. Ve bunu birden fazla sayfada yapmak. Sayfalardaki veri yapışma yeri ve düzeni değişmiyor.
Dosyam ektedir. Yardımcı olabileceklere şimdiden teşekkürler.

 

[Ömer]

Merhaba,

Eski veri silinip üzerine mi yazılacak? Yoksa örnek te belirttiğiniz gibi alt kısmına mı düzenleme olacak?

 

[AdemCan]

Merhaba
11. satırdan itibaren aşağı doğru sıralı olan verileri silip, yatay olan tabloyu alt alta sıralamak için örnek kod.

Sub test()
Application.ScreenUpdating = False
x = 10
For s = 1 To Sheets.Count
son = Sheets(s).Cells(Rows.Count, 2).End(3).Row
Sheets(s).Range("B11:E" & son + 1).Clear
    For c = 2 To 13
        For r = 4 To 7
            x = x + 1
            Sheets(s).Cells(x, 2) = Sheets(s).Range("B2")
            Sheets(s).Cells(x, 3) = Sheets(s).Cells(3, c)
            Sheets(s).Cells(x, 4) = Sheets(s).Cells(r, 1)
            Sheets(s).Cells(x, 5) = Sheets(s).Cells(r, c)
            Sheets(s).Cells(x, 5).NumberFormat = "#,##0"
        Next r
    Next c
    c = 2: r = 4: x = 10
Next s
Application.ScreenUpdating = True
End Sub

 

[aydinsert]

Merhaba,

Eski veri silinip üzerine mi yazılacak? Yoksa örnek te belirttiğiniz gibi alt kısmına mı düzenleme olacak?

Alt kısıma yazılacak.

 

[aydinsert]

Merhaba
11. satırdan itibaren aşağı doğru sıralı olan verileri silip, yatay olan tabloyu alt alta sıralamak için örnek kod.

Sub test()
Application.ScreenUpdating = False
x = 10
For s = 1 To Sheets.Count
son = Sheets(s).Cells(Rows.Count, 2).End(3).Row
Sheets(s).Range("B11:E" & son + 1).Clear
    For c = 2 To 13
        For r = 4 To 7
            x = x + 1
            Sheets(s).Cells(x, 2) = Sheets(s).Range("B2")
            Sheets(s).Cells(x, 3) = Sheets(s).Cells(3, c)
            Sheets(s).Cells(x, 4) = Sheets(s).Cells(r, 1)
            Sheets(s).Cells(x, 5) = Sheets(s).Cells(r, c)
            Sheets(s).Cells(x, 5).NumberFormat = "#,##0"
        Next r
    Next c
    c = 2: r = 4: x = 10
Next s
Application.ScreenUpdating = True
End Sub

Elinize sağlık çok güzel çalışıyor. Dosyadaki diğer sayfalara otomatik nasıl uygulayabilirim peki?
Yani 2.sayfaya, 3. sayfaya vs.

 

[AdemCan]

Rica ederim. Modül içerisine ekleyip çalıştırın, Dosyadaki tüm sayfalara uygulama yapar bu kod.

 

[aydinsert]

Rica ederim. Modül içerisine ekleyip çalıştırın, Dosyadaki tüm sayfalara uygulama yapar bu kod.

Aynen dediğiniz gibi diğer saylara da yapıştırıyor. Sonradan fark ettim. Tekrar teşekkürler.

 

[AdemCan]

Rica ederim, iyi çalışmalar.