Makro ile diger sayfalara ceri transferi

[freeline]

merhaba arkadaslar exelde yapmis oldugum bi calisma kitabim var calismalarima büyük yardimi olan bi makro yapmisti bi arkadasim yapmasini istedigim sey suydu ( sayfa 1 de 2.satirdan 37. satira kadar yazdiklarim sayfa 3 ün ayni satirlarina da yazilsin yine sayfa 1 in 38. satirindan 91 inci satirina kadar olan kisma yazilanlar sayfa 4 ün 2ci tarindan 55. satirlari arasina yazilsin (55.satir dahil) ayni sekilde sayfa 1 in 92. satirindan 127.satira kadar olan kisimda sayfa 5 in 2.ci satirindan 37 . satirina kadar olan kisma yazilsin son olarakta yine sayfa 1 in 128.satirindan 167. satirina kadar olan kisma da yazilanlar sayfa 6 nin 2.satirindan 37. satirina kadar olan kisma yazilsin.Sayfa 1 yazdiklarimin diger sayfalara gecmesi icin bir button kullanayim ve arkadasimin yaptigi (

Sub aktar()

Application.ScreenUpdating = False



Dim i, k, sut1 As Integer





For i = 2 To 37

For sut1 = 1 To 12

Sayfa3.Cells(i, sut1).Value = Sayfa1.Cells(i, sut1).Value

Next sut1

Next i



For k = 38 To 91

For sut1 = 1 To 12

Sayfa4.Cells(k - 36, sut1).Value = Sayfa1.Cells(k, sut1).Value

Next sut1

Next k



For T = 92 To 127

For sut1 = 1 To 12

Sayfa5.Cells(T - 90, sut1).Value = Sayfa1.Cells(T, sut1).Value

Next sut1

Next T



For tt = 128 To 167

For sut1 = 1 To 12

Sayfa6.Cells(tt - 126, sut1).Value = Sayfa1.Cells(tt, sut1).Value

Next sut1

Next tt

Application.ScreenUpdating = True

End Sub



simdi istedigim ise bunun üstünde ufak bi degisiklik yapmak söyle bunda sayfa 1 e yazdiklarim 2 den 53 e kadar sayfa 2 nin 2-52 ye 54-82 sayfa 3 ün 2-29 a 83-127 sayfa 4 ün 2-45 ine 128-145 sayfa 5 in 2-18 ine 146-185 sayfa 6 nin 2-40 ina 186-270 de sayfa 7 2-85 ine gecicek anlayan arkadaslar bi el atarlar umarim

 

[freeline]

kimse yapmak istedigimi mi anlamadi yoksa zor bisey mi istedim bilemiyorum arkadaslar istedigim yukarda vermis oldugum kodlar 4 sayfa icin istedigim ilaveten 2 sayfa icin daha ayni kodlardan ekleme yapmak

 

[ark123]

kimse yapmak istedigimi mi anlamadi yoksa zor bisey mi istedim bilemiyorum arkadaslar istedigim yukarda vermis oldugum kodlar 4 sayfa icin istedigim ilaveten 2 sayfa icin daha ayni kodlardan ekleme yapmak

Sub aktar()

Application.ScreenUpdating = False



Dim i, k, sut1 As Integer





For i = 2 To 37

For sut1 = 1 To 12

Sayfa3.Cells(i, sut1).Value = Sayfa1.Cells(i, sut1).Value

Next sut1

Next i



For k = 38 To 91

For sut1 = 1 To 12

Sayfa4.Cells(k - 36, sut1).Value = Sayfa1.Cells(k, sut1).Value

Next sut1

Next k



For T = 92 To 127

For sut1 = 1 To 12

Sayfa5.Cells(T - 90, sut1).Value = Sayfa1.Cells(T, sut1).Value

Next sut1

Next T



For tt = 128 To 167

For sut1 = 1 To 12

Sayfa6.Cells(tt - 126, sut1).Value = Sayfa1.Cells(tt, sut1).Value

Next sut1

Next tt

Application.ScreenUpdating = True

End Sub

yukardaki kodlar işini görmedimi

 

[freeline]

yukardaki kodlar tam istedigim gibi isimi görüyordu ama 4 sayfa icin hazirlanmis simdi bana gerekli olan ayni sekilde 6 sayfa icin bunlara sayfa 7 ve 8 de ekleyebilirsek tamam olcak

 

[freeline]

cözüldü konu kapanabilir