vba da aktarma

[talatcd]

slm arkadaşlar böyle bir bordro yaptımıştım. Tek satırda olduğu için bir a4 kağıdına sığmıyor. Bunu icmal dosyasına tek bordro sayfasından aktarıyorum personeli teker teker aktarıyorum ve çizgilerini ben çiziyorum. BORDRO sayfasından nasıl bütün personeli nasıl aktarabiliriz. ve çizgileri nasıl çizeriz. Birde değişik bir şey yaptım DÃ?KÜM sayfası tam bitmedi fakat burada da yine bütün personeli aktarma ve sabit hücrelerdeki veriyi nasıl alabilirim.

 

[Levent Menteşoğlu]

Aktar butonundaki kodu aşağıdaki ile değiştirerek deneyin.

[vb:1:b2b9f8a5ad]Sub Aktar()
Set s1 = Sheets("İcmal")
For b = 1 To 25
[a1] = b
a = WorksheetFunction.CountA(Sheets("İcmal").Range("B6:B65536"))
If a Mod 3 = 0 Then
adr = "a" & a + 6 & ":q" & a + 8
s1.Range(adr).Borders(xlEdgeTop).Weight = xlThin
s1.Range(adr).Borders(xlEdgeBottom).Weight = xlThin
s1.Range(adr).Borders(xlEdgeLeft).Weight = xlThin
s1.Range(adr).Borders(xlEdgeRight).Weight = xlThin
End If
s1.Range("A" & a + 6) = [a1]
s1.Range("A" & a + 7) = [D3]
s1.Range("A" & a + 8) = [d4]
s1.Range("B" & a + 6) = [D12]
s1.Range("B" & a + 7) = [D13]
s1.Range("B" & a + 8) = [D14]
s1.Range("C" & a + 6) = [D9]
s1.Range("C" & a + 7) = [D10]
s1.Range("C" & a + 8) = [D11]
s1.Range("D" & a + 8) = [D15]
s1.Range("D" & a + 7) = [D6] & "-" & [D7]
s1.Range("D" & a + 6) = [k4]
s1.Range("E" & a + 6) = [H9]
s1.Range("E" & a + 7) = [H10]
s1.Range("E" & a + 8) = [H11]
s1.Range("F" & a + 6) = [H12]
s1.Range("F" & a + 7) = [H13]
s1.Range("F" & a + 8) = [H14]
s1.Range("G" & a + 6) = [H15]
s1.Range("G" & a + 7) = [H16]
s1.Range("G" & a + 8) = [H17]
s1.Range("H" & a + 6) = [H18]
s1.Range("H" & a + 7) = [H19]
s1.Range("H" & a + 8) = [H20]
s1.Range("I" & a + 6) = [H21]
s1.Range("I" & a + 7) = [H22]
s1.Range("I" & a + 8) = [H23]
s1.Range("J" & a + 6) = [H24]
s1.Range("J" & a + 7) = [H25]
s1.Range("J" & a + 8) = [E27]
s1.Range("K" & a + 6) = [B27]
s1.Range("K" & a + 7) = [B25]
s1.Range("K" & a + 8) = [D22]
s1.Range("L" & a + 6) = [K9]
s1.Range("L" & a + 7) = [K10]
s1.Range("L" & a + 8) = [K17]
s1.Range("M" & a + 6) = [K11]
s1.Range("M" & a + 7) = [K12]
s1.Range("M" & a + 8) = [K13]
s1.Range("N" & a + 6) = [K14]
s1.Range("N" & a + 7) = [K15]
s1.Range("N" & a + 8) = [K16]
s1.Range("O" & a + 6) = [K18]
s1.Range("O" & a + 7) = [K19]
s1.Range("O" & a + 8) = [K20]
s1.Range("P" & a + 6) = [K21]
s1.Range("P" & a + 7) = [K22]
s1.Range("P" & a + 8) = [K23]
s1.Range("Q" & a + 6) = [K24]
s1.Range("Q" & a + 7) = [G27]
s1.Range("Q" & a + 8) = [I27]
Next
End Sub[/vb:1:b2b9f8a5ad]