Sutunları belirli kriterlere göre satırlara donusturme

[svtcsn]

Arskadaşlar sutunları satırlara donuşturmeyte çalıştıgım bır tablom var bir örnek ekliyorum bincelermısınız yapılabılır bırşeylerlemı ugraşıyorum. yada nasıl yaparım yardımcı olurmusununz.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, X As Long, Y As Integer, Satır As Long
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
 
    S2.Range("A2:H65536").ClearContents
 
    Satır = 2
 
    For X = 2 To S1.Range("A65536").End(3).Row
        For Y = 5 To 253 Step 4
            If S1.Cells(X, Y) <> Empty Then
                S2.Range("A" & Satır & ":D" & Satır).Value = S1.Range("A" & X & ":D" & X).Value
                S2.Range("E" & Satır & ":H" & Satır).Value = S1.Range(Cells(X, Y).Address, Cells(X, Y + 3).Address).Value
                Satır = Satır + 1
            End If
        Next
    Next
 
    Set S1 = Nothing
    Set S2 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[svtcsn]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, X As Long, Y As Integer, Satır As Long
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
 
    S2.Range("A2:H65536").ClearContents
 
    Satır = 2
 
    For X = 2 To S1.Range("A65536").End(3).Row
        For Y = 5 To 256 Step 4
            If S1.Cells(2, Y) <> Empty Then
                S2.Range("A" & Satır & ":D" & Satır).Value = S1.Range("A" & X & ":D" & X).Value
                S2.Range("E" & Satır & ":H" & Satır).Value = S1.Range(Cells(X, Y).Address, Cells(X, Y + 4).Address).Value
                Satır = Satır + 1
            End If
        Next
    Next
 
    Set S1 = Nothing
    Set S2 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Hocam ellerine sağlık mukemmel olmuş fakat bu veriler sabit değil xxx turu 25 sutun kaplarken yyy turu 256 ya kadar çıkıyor bunu nasıl çözebiliriz.

 

[Korhan Ayhan]

Selamlar,

Önerdiğim kod zaten 256 sütunu kapsayacak şekildedir.

 

[svtcsn]

ama maksimum (ab) sütununa kadar okuyabiliyor.

 

[svtcsn]

Selamlar,

Önerdiğim kod zaten 256 sütunu kapsayacak şekildedir.

Selam Hocam,
örnek dosyayı gönderiyorum birde siz incelermisiniz.

 

[Korhan Ayhan]

Selamlar,

#2 nolu mesajımdaki kodu güncelledim. İncelermisiniz.

 

[svtcsn]

Hocam,
sorun birici verideki bilgiden kaynaklanıyor birinci veri kaç sutun gidiyorsa diğer verileride maksimum o kadar okuyor, ve ilk veri maksimum kapasitedeyse son veriyi okumuyor, altındaki veriler bir üst veriden kısa ise alt verileri okumuyor.

 

[svtcsn]

Selamlar,

#2 nolu mesajımdaki kodu güncelledim. İncelermisiniz.

Hocam ellerinize sağlık harika oldu tam istediğim gibi çook teşekkürler. :bravo::mutlu: