bir sayfadan diğer sayfaya veri dağıtma

[imyourfate]

Değerli hocalarım saygılarımı sunuyorum

ekli dosyada yer alan veri sayfasından oda sayfasına veri taşımak için bir makroya ihtiyacım var veri sayfasındaki mavi zeminli alanda bulunan 11STZ başlıklı kısımda (hemen altında)tarih ve günleri belirten bir şablon var bu şablondaki değerleri oda sayfasındaki aynı ay ve güne gelecek şekilde aktarmam gerekiyor örnek:veri sayfası AJ4 hücresi; oda sayfasında B3hücresinde gösterilecek ve diğer tarihlerde bunu takip edecek



şimdiden teşekkür ediyorum

saygılar

 

[chngrcn]

Dosyanız ektedir.. inceleyiniz..

Sub aktar() ' CODED BY CİHANGİR..
On Error Resume Next

Worksheets("oda").Range("B3:V33").ClearContents

Set s1 = Sheets("veri")
Set s2 = Sheets("oda")

y = s2.[B65536].End(3).Row + 1

Application.ScreenUpdating = False

For i = 36 To s1.Cells(4, s1.Columns.Count).End(xlToLeft).Column

s2.Cells(y, 2) = s1.Cells(4, i)    'nisan ayı
s2.Cells(y, 3) = s1.Cells(20, i)
s2.Cells(y, 4) = s1.Cells(36, i)

s2.Cells(y, 5) = s1.Cells(6, i)  'mayıs
s2.Cells(y, 6) = s1.Cells(22, i)
s2.Cells(y, 7) = s1.Cells(38, i)

s2.Cells(y, 8) = s1.Cells(8, i)  'haziran
s2.Cells(y, 9) = s1.Cells(24, i)
s2.Cells(y, 10) = s1.Cells(40, i)

s2.Cells(y, 11) = s1.Cells(10, i)  'temmuz
s2.Cells(y, 12) = s1.Cells(26, i)
s2.Cells(y, 13) = s1.Cells(42, i)

s2.Cells(y, 14) = s1.Cells(12, i)  'ağustos
s2.Cells(y, 15) = s1.Cells(28, i)
s2.Cells(y, 16) = s1.Cells(44, i)

s2.Cells(y, 17) = s1.Cells(14, i)  'eylül
s2.Cells(y, 18) = s1.Cells(30, i)
s2.Cells(y, 19) = s1.Cells(46, i)

s2.Cells(y, 20) = s1.Cells(16, i)  'ekim
s2.Cells(y, 21) = s1.Cells(32, i)
s2.Cells(y, 22) = s1.Cells(48, i)

y = y + 1

Next

Application.ScreenUpdating = True

MsgBox " Aktarım tamamlandı...", , ""

End Sub