ACİL . HAZIR MAKRO ÜZERİNDE BİR EKSİKLİK

[melwitch]

ACÝL . HAZIR MAKRO ÜZERÝNDE BÝR EKSÝKLÝK

Sheet 2 de yer alan bir tabloya ait bilgilerin Sheet 1 'e alınması için ekteki makroyu yazmıştık. Ancak Sheet 1 e bilgiler atılırken ekte yer alan kırmızı ile işaretli alanlarında sırayla alt alta yazdırılması gerekiyordu. Yani
"B8" de bir bilgi varsa "D11" deki hesap, "B9" da bir bilgi varsa "F11" deki hesap, "B10" nada bir bilgi girilmişse "H11" deki hesap, ve satır açılarak B deki alanlar arttırıldığında "L6" ya kadar olan alan alt alta SHEET 1 e yazdırılmalı.

Bu konuda bana yardımcı olursanız çok sevinirim.

Not: Tablonun altında yer alan makrosu değişmeyecek kısımları "hide" yaptım.

syg

 

[keniken]

Sub listeyeaktar()
l = 2
Sheets("sheet1").Select
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
say = WorksheetFunction.CountA(s2.[b7:b10])
For sat = 1 To say
c = WorksheetFunction.CountA(s1.[b2:b65536])
s1.Cells(c + 2, 2) = s2.[d14].Value
s1.Cells(c + 2, 3) = s2.[b5].Value
s1.Cells(c + 2, 4) = s2.Cells(11, l).Value
s1.Cells(c + 2, 5) = s2.Cells(sat + 6, 2).Value
s1.Cells(c + 2, 6) = s2.[b6].Value
s1.Cells(c + 2, 7) = s2.[d53].Value
s1.Cells(c + 2, 11) = s2.[d12].Value
s1.Cells(c + 2, 12) = s2.[j15].Value
s1.Cells(c + 2, 13) = s2.[l18].Value
s1.Cells(c + 2, 14) = s2.[l49].Value
s1.Cells(c + 2, 16) = s2.[a47].Value
s1.Cells(c + 2, 17) = s2.Cells(sat * 5 + 13, 8).Value + s2.Cells(sat * 5 + 14, 8).Value
s1.Cells(c + 2, 18) = s2.Cells(sat * 5 + 15, 8).Value + s2.Cells(sat * 5 + 16, 8).Value
s1.Cells(c + 2, 19) = s2.Cells(sat * 5 + 13, 8).Value + s2.Cells(sat * 5 + 14, 8).Value + s2.Cells(sat * 5 + 15, 8).Value + s2.Cells(sat * 5 + 16, 8).Value
l = l + 2
Next
End Sub

 

[melwitch]

öyle makbule geçtiki anlatamam...

ÇOK AMA ÇOK TEÞEKKÜR :icelim: