makro ile iki kayıt

[igultekin2000]

iyi akşamlar;
excel şablonla hazırladığım taboyla fatura yazdırıyorum. aynı zamanda kesilen faturalara bilgilerini arşivlemek için makroya kod ilave etmek veya farklı bir makro kullanmak istiyorum. örnek dosya ve resmini ekledim. yardımcı olacak arkadaşlara teşekkürler.

 

[Excelmy]

Sayın igultekin2000

Dosyanıza ekleyeceğiniz bir modül ile aşağıdaki kodları uygulayınız.

Sub arsiv()
For i = 16 To Sheets("Giris").Cells(Rows.Count, "C").End(3).Row
    say = 0
    say = say + i - 1
    Sheets("Giris").Range("C" & say + 1).Select
    son = Sheets("arsiv").Range("A65536").End(3).Row + 1
    Sheets("arsiv").Cells(son, 1).Value = Format(Sheets("Giris").Range("C8"), "dd.mm.yyyy")
    Sheets("arsiv").Cells(son, 2).Value = Sheets("Giris").Range("C1")
    Sheets("arsiv").Cells(son, 3).Value = ActiveCell.Offset(0, 0): ActiveCell.Offset(0, 0) = ""
    Sheets("arsiv").Cells(son, 4).Value = ActiveCell.Offset(0, 1): ActiveCell.Offset(0, 1) = ""
    Sheets("arsiv").Cells(son, 5).Value = ActiveCell.Offset(0, 2): ActiveCell.Offset(0, 2) = ""
    Sheets("arsiv").Cells(son, 6).Value = ActiveCell.Offset(0, 3) * 1: ActiveCell.Offset(0, 3) = ""
    Sheets("arsiv").Cells(son, 7).Value = ActiveCell.Offset(0, 4) * 1: ActiveCell.Offset(0, 4) = ""
Next
End Sub

 

[igultekin2000]

sorunsuz çalışıyor

Sayın igultekin2000

Dosyanıza ekleyeceğiniz bir modül ile aşağıdaki kodları uygulayınız.

Sub arsiv()
For i = 16 To Sheets("Giris").Cells(Rows.Count, "C").End(3).Row
    say = 0
    say = say + i - 1
    Sheets("Giris").Range("C" & say + 1).Select
    son = Sheets("arsiv").Range("A65536").End(3).Row + 1
    Sheets("arsiv").Cells(son, 1).Value = Format(Sheets("Giris").Range("C8"), "dd.mm.yyyy")
    Sheets("arsiv").Cells(son, 2).Value = Sheets("Giris").Range("C1")
    Sheets("arsiv").Cells(son, 3).Value = ActiveCell.Offset(0, 0): ActiveCell.Offset(0, 0) = ""
    Sheets("arsiv").Cells(son, 4).Value = ActiveCell.Offset(0, 1): ActiveCell.Offset(0, 1) = ""
    Sheets("arsiv").Cells(son, 5).Value = ActiveCell.Offset(0, 2): ActiveCell.Offset(0, 2) = ""
    Sheets("arsiv").Cells(son, 6).Value = ActiveCell.Offset(0, 3) * 1: ActiveCell.Offset(0, 3) = ""
    Sheets("arsiv").Cells(son, 7).Value = ActiveCell.Offset(0, 4) * 1: ActiveCell.Offset(0, 4) = ""
Next
End Sub

Teşekküler kod sorunsuz çalışıyor.