Soru makro ile exceli tekrar düzenlemek

[bycakir]

[TR][TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD][/TR]
[TR][TD]
merhabalar.
ben bir sayfadaki verileri duruşlarını değiştirmek için aşagıdaki makroyu yazdım fakat excell de hata var çözemiyorum .

kayıt aldıgım sayfayi 5 satır atlatarak yaptıgımda çalışıyor ama 5 atlayarak bu istediğim çözüm değil

Sub Test()
son = WorksheetFunction.Max(Cells(Rows.Count, "A").End(3).Row, 2)
For i = 2 To son
   Sayfa4.Cells(i, "A") = Cells(i, "A")
   Sayfa4.Cells(i, "b") = Cells(1, 2)
   Sayfa4.Cells(i, "c") = Cells(i, "B")
   Sayfa4.Cells(i, "d") = Cells(i, "g")
   Sayfa4.Cells(i, "e") = Cells(i, "h")
   Sayfa4.Cells(i + 1, "A") = Cells(i, "A")
   Sayfa4.Cells(i + 1, "b") = Cells(1, 3)
   Sayfa4.Cells(i + 1, "c") = Cells(i, "c")
   Sayfa4.Cells(i + 1, "d") = Cells(i, "g")
   Sayfa4.Cells(i + 1, "e") = Cells(i, "h")
   Sayfa4.Cells(i + 2, "A") = Cells(i, "A")
   Sayfa4.Cells(i + 2, "b") = Cells(1, 4)
   Sayfa4.Cells(i + 2, "c") = Cells(i, "d")
   Sayfa4.Cells(i + 2, "d") = Cells(i, "g")
   Sayfa4.Cells(i + 2, "e") = Cells(i, "h")
   Sayfa4.Cells(i + 3, "A") = Cells(i, "A")
   Sayfa4.Cells(i + 3, "b") = Cells(1, 5)
   Sayfa4.Cells(i + 3, "c") = Cells(i, "e")
   Sayfa4.Cells(i + 3, "d") = Cells(i, "g")
   Sayfa4.Cells(i + 3, "e") = Cells(i, "h")
   Sayfa4.Cells(i + 4, "A") = Cells(i, "A")
   Sayfa4.Cells(i + 4, "b") = Cells(1, 6)
   Sayfa4.Cells(i + 4, "c") = Cells(i, "f")
   Sayfa4.Cells(i + 4, "d") = Cells(i, "g")
   Sayfa4.Cells(i + 4, "e") = Cells(i, "h")
   i = i + 4
 
 
Next

End Sub

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD][/TR]
[TR][TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD][/TR]

 

[Ömer]

Merhaba

Örnek dosya ekleyerek yapmak istediğinizi dosya üzerinde detaylı açıklar mısınız.

 

[bycakir]

dosya eklenmiştir . safya 1 deki sıraya re sıralamasını istiyorum . fakat sayfa 2 ye satır atlayarak yapıyor.

 

[bycakir]

ilk 5 satırı elle düzenleyerek tekrar yukledim.

 

[ÖmerFaruk]

Aşağıdai gibi kullanabilrisiniz.

Sub Test()
    son = WorksheetFunction.Max(Cells(Rows.Count, "A").End(3).Row, 2)
    Sayfa4.Range("A2:E" & Rows.Count) = ""
    k = 2
    For i = 2 To son
        k = k + x
        For x = 0 To 4
            Sayfa4.Range("A" & k + x) = Range("A" & i)
            Sayfa4.Range("D" & k + x) = Range("G" & i)
            Sayfa4.Range("E" & k + x) = Range("H" & i)
            Select Case x
                Case 0
                Sayfa4.Range("B" & k + x) = Range("B" & 1)
                Sayfa4.Range("C" & k + x) = Range("B" & i)
                Case 1
                Sayfa4.Range("B" & k + x) = Range("C" & 1)
                Sayfa4.Range("C" & k + x) = Range("C" & i)
                Case 2
                Sayfa4.Range("B" & k + x) = Range("D" & 1)
                Sayfa4.Range("C" & k + x) = Range("D" & i)
                Case 3
                Sayfa4.Range("B" & k + x) = Range("E" & 1)
                Sayfa4.Range("C" & k + x) = Range("E" & i)
                Case 4
                Sayfa4.Range("B" & k + x) = Range("F" & 1)
                Sayfa4.Range("C" & k + x) = Range("F" & i)
            End Select
        Next x
    Next i
End Sub

 

[bycakir]

@ÖmerFaruk bey;

teşekkurler çalıştı