Makroyla satır takip ederek fatura kesimi

[siar]

Herkese Merhabalar,

Ekli listede de görülebileceği üzere, 100 - 200 kayıt üzerinden fatura kesmem gerekiyor. Yapmak istediğim şey münferit kesilecek faturalar sayfasına atayacağım buton ile o sayfa üzerindeki tüm satırları tek tek, fatura sayfasına aktararak print ettirmek.
Fatura sayfasına alınacak değerleri, formüllerle bağlamış bulumaktayız. Şimdiden teşekkür ederim.

 

[Necdet]

Fatura Yazdır

Merhaba,

Aşağıdaki kodları bir butona bağlayıp deneyebilirsiniz.

Public Sub AktarYaz()
Application.ScreenUpdating = False
Set m = Sheets("MUNFERIT KESILECEK FT.")
Set f = Sheets("Fatura")
f.Select
SonSatır = m.[K65536].End(3).Row
[COLOR=red][B]For i = 2 To SonSatır
[/B][/COLOR]    [C11] = m.Cells(i, "K")
    [AE14] = m.Cells(i, "B")
    [C16] = m.Cells(i, "L")
    [C19] = m.Cells(i, "V")
    [L19] = m.Cells(i, "E")
    [N19] = m.Cells(i, "F")
    [AF19] = m.Cells(i, "T")
    [M22] = m.Cells(i, "J")
    [R23] = m.Cells(i, "H")
    [AF33] = m.Cells(i, "J")
    [I35] = m.Cells(i, "Y")
    ActiveSheet.PrintOut
Next i
End Sub

deneme için renkli olan yerde sonsatır yerine 3 derseniz ilk iki faturayı döker.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub AKTAR_YAZDIR()
    Set SF = Sheets("Fatura")
    For X = 2 To [B65536].End(3).Row
    SF.[C11] = Cells(X, "K")
    SF.[C16] = Cells(X, "L")
    SF.[AE14] = Cells(X, "B")
    SF.[C19] = Cells(X, "V")
    SF.[L19] = Cells(X, "E")
    SF.[N19] = Cells(X, "F")
    SF.[AF19] = Cells(X, "T")
    SF.[M22] = Cells(X, "J")
    SF.[R23] = Cells(X, "H")
    SF.[AF33] = Cells(X, "S")
    SF.[I35] = Cells(X, "Y")
    SF.PrintOut
    Next
    MsgBox "Veriler aktarılıp yazdırılmıştır.", vbInformation
End Sub

 

[siar]

Arkadaşlar emeklerinize çok teşekkür ederim. Fakat biraz tembellik yapmayıp zorlayınca ben ekteki gibi bir yöntem buldum. Tekrar tekrar teşekkür ederim.