kod birleştirme

[uurc1]

Arkadaşlar yaptığım excel çalışmasında aşağıda yer alan kodlar bulunuyor bunları ayrı tuşlara makro olarak atadım 1. makroda verileri istatistik sayfasına atıyor. 2. makro ise seçili aralığı arkalı önlü olarak yazdırıyor.

bu makroları birleştirerek tek tuş ile aynı işlemleri yapmak istiyorum yardımcı olursanız sevinirim.
şimdiden teşekkür ederim.

1. Kod

Sub AKTAR()
Dim a As Worksheet: Set a = Sheets("AVANS")
Dim l As Worksheet: Set l = Sheets("istatistik")
If a.Cells(94, 83) = "" Or a.Cells(95, 83) = "" Or a.Cells(96, 83) = "" Or a.Cells(97, 83) = "" Or a.Cells(98, 83) = "" Or a.Cells(99, 83) = "" Then
    MsgBox "TÜM ALANLAR DOLDURULMADAN KAYIT YAPILAMAZ.": Exit Sub
End If
satır = l.[A65536].End(3).Row + 1
    l.Cells(satır, 1) = satır - 2
    l.Cells(satır, 2) = a.Cells(94, 83): l.Cells(satır, 3) = a.Cells(95, 83)
    l.Cells(satır, 4) = a.Cells(96, 83): l.Cells(satır, 5) = a.Cells(97, 83)
    l.Cells(satır, 6) = a.Cells(98, 83): l.Cells(satır, 7) = a.Cells(144, 100)
        a.Cells(11, 2) = "": a.Cells(11, 3) = "": a.Cells(8, 11) = "": a.Cells(8, 17) = ""
    a.Cells(11, 1) = satır - 1
MsgBox "KAYIT TAMAM"
End Sub

2. Kod.

Sub yazdır()
'
' yazdır Makro
'

'
    ActiveWindow.SmallScroll Down:=-15
    Range("A94:CB137").Select
    Selection.PrintOut Copies:=1, Collate:=True
End Sub

 

[YUSUF44]

Aşağıdaki gibi oluyor mu?

Sub AKTAR()
Dim a As Worksheet: Set a = Sheets("AVANS")
Dim l As Worksheet: Set l = Sheets("istatistik")
If a.Cells(94, 83) = "" Or a.Cells(95, 83) = "" Or a.Cells(96, 83) = "" Or a.Cells(97, 83) = "" Or a.Cells(98, 83) = "" Or a.Cells(99, 83) = "" Then
    MsgBox "TÜM ALANLAR DOLDURULMADAN KAYIT YAPILAMAZ.": Exit Sub
End If
satır = l.[A65536].End(3).Row + 1
    l.Cells(satır, 1) = satır - 2
    l.Cells(satır, 2) = a.Cells(94, 83): l.Cells(satır, 3) = a.Cells(95, 83)
    l.Cells(satır, 4) = a.Cells(96, 83): l.Cells(satır, 5) = a.Cells(97, 83)
    l.Cells(satır, 6) = a.Cells(98, 83): l.Cells(satır, 7) = a.Cells(144, 100)
        a.Cells(11, 2) = "": a.Cells(11, 3) = "": a.Cells(8, 11) = "": a.Cells(8, 17) = ""
    a.Cells(11, 1) = satır - 1

    [B]Range("A94:CB137").Select
    Selection.PrintOut Copies:=1, Collate:=True
MsgBox "KAYIT ve YAZDIRMA TAMAM"[/B]
End Sub

 

[uurc1]

teşekkür ederim üsatat çalıştı.