Aşağıdaki kodda verileri istatistik sayfasına aktarma işlemi ve yazdırma işlemi aynı anda yapmaktayım.
ancak birde istatistik2 sayfasına veri almam gerekiyor. Aktar kodunu kopyalayarak yapmaya çalıştım ancak bir türlü kodu birleştiremedim sürekli hata veriyor.
bu iki kodu nasıl birleştirebilirim yardım ederseniz sevinirim.
ancak birde istatistik2 sayfasına veri almam gerekiyor. Aktar kodunu kopyalayarak yapmaya çalıştım ancak bir türlü kodu birleştiremedim sürekli hata veriyor.
bu iki kodu nasıl birleştirebilirim yardım ederseniz sevinirim.
Kod:
Sub AKTAR()
Dim a As Worksheet: Set a = Sheets("yazı")
Dim l As Worksheet: Set l = Sheets("istatistik1")
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(144, 100)
l.Cells(satır, 6) = a.Cells(101, 83): l.Cells(satır, 7) = a.Cells(102, 83)
l.Cells(satır, 8) = a.Cells(98, 103): l.Cells(satır, 9) = a.Cells(96, 86)
a.Cells(11, 2) = "": a.Cells(11, 3) = "": a.Cells(8, 11) = "": a.Cells(8, 17) = ""
a.Cells(11, 1) = satır - 1
Range("A94:CB137").Select
Selection.PrintOut Copies:=1, Collate:=True
MsgBox "KAYIT ve YAZDIRMA TAMAM TÜM YAZDIRMA İŞLEMLERİ SONRASINDA İSTATİSTİK SAYFASININ KONTROLÜNÜ YAPINIZ"
End Sub
Kod:
Sub Banka()
Dim a As Worksheet: Set a = Sheets("YAZI")
Dim l As Worksheet: Set l = Sheets("istatistik2")
If a.Cells(94, 83) = "" Or a.Cells(127, 100) = "" Or a.Cells(102, 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 - 15
l.Cells(satır, 2) = a.Cells(94, 83): l.Cells(satır, 3) = a.Cells(126, 100)
l.Cells(satır, 4) = a.Cells(127, 100): l.Cells(satır, 5) = a.Cells(102, 83)
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
Son düzenleme:
