Mevcut Kod'da Düzenleme (Veri Aktar)

[1Al2Ver]

Merhaba,

Yapmak istediğim,

ÇIKIŞA_AKTAR makrosu çalıştırıldığında, verileri;

Önce, "ÇIKIŞ" sayfasına aktarsın,

Sonra, KAYIT_ET () makrosunu çağırarak "MEVCUTLAR" sayfasına aktarsın,

En son, yazdırsın ve ilgili yerleri silsin.

YADA,

ÇIKIŞA_AKTAR makrosunu çalıştırınca;

Önce, "ÇIKIŞ" sayfasına aktarsın,

Sonra, "KAYIT" sayfası H1'deki tarihe göre, C3:C4 aralığını "MEVCUTLAR" sayfası "B" sütununa,

C6:16 aralığını, "MEVCUTLAR" sayfası "D" sütununa aktarsın,

En son, yazdırsın ve ilgili yerleri silsin.

Özetle, bu 2 kodu, tek bir düğme ile çalıştırmak istiyorum.

Teşekkür ederim.

Sub ÇIKIŞA_AKTAR() 

Set S2 = Sheets("KAYIT"): Set s3 = Sheets("Çıkış")
ilksatır = 17: sonsatır = S2.[O60].End(3).Row: tarih = S2.[H1]
For satır = ilksatır To sonsatır
s3satır = s3.[A65536].End(3).Row + 1

    s3.Cells(s3satır, 1) = tarih: s3.Cells(s3satır, 2) = S2.Cells(satır, 2)
    s3.Cells(s3satır, 2) = S2.Cells(satır, 12): s3.Cells(s3satır, 3) = S2.Cells(satır, 13)
    s3.Cells(s3satır, 4) = S2.Cells(satır, 14): s3.Cells(s3satır, 5) = S2.Cells(satır, 15)
    
    Next
S2.Range("A1:I73").PrintOut
S2.Range("A17:I59,K17:O59,D3:D4,D6:D13,H5:H13").ClearContents
    
End Sub

KAYIT_ET () makrosu

Sub KAYIT_ET()
    Set s1 = Sheets("KAYIT")
    Set s2 = Sheets("MEVCUTLAR")
    
    yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
    
    s2.Cells(yeni, "A") = s1.[H1]
    
    s1.Range("C3:C4").Copy: s2.Cells(yeni, "B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    
    s1.Range("C6:C14").Copy: s2.Cells(yeni, "D").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Application.CutCopyMode = False
    s1.Range("C3,C4,C6:C13").ClearContents
    s1.Activate
    s1.[H1].Select
    
End Sub

 

[YUSUF44]

çıkışa aktar makrosunun yazdırma satırından sonra kayıt et makrosunu çalıştırabilirsiniz:

Sub ÇIKIŞA_AKTAR() 

Set S2 = Sheets("KAYIT"): Set s3 = Sheets("Çıkış")
ilksatır = 17: sonsatır = S2.[O60].End(3).Row: tarih = S2.[H1]
For satır = ilksatır To sonsatır
s3satır = s3.[A65536].End(3).Row + 1

    s3.Cells(s3satır, 1) = tarih: s3.Cells(s3satır, 2) = S2.Cells(satır, 2)
    s3.Cells(s3satır, 2) = S2.Cells(satır, 12): s3.Cells(s3satır, 3) = S2.Cells(satır, 13)
    s3.Cells(s3satır, 4) = S2.Cells(satır, 14): s3.Cells(s3satır, 5) = S2.Cells(satır, 15)
    
    Next
S2.Range("A1:I73").PrintOut
[COLOR="Red"]Call KAYIT_ET()[/COLOR]
S2.Range("A17:I59,K17:O59,D3:D4,D6:D13,H5:H13").ClearContents
    
End Sub

gibi.

 

[1Al2Ver]

Sayın YUSUF44 merhaba,

Öncelikle nezaketiniz ve çözüm için teşekkür ederim,

Öğrenmek adına ;

Çıkışa_Aktar ve Kayıt_Et, makrolarını birleştirerek tek bir kod yapmak istiyorum,

Yardımcı olursanız memnun olurum.

Saygılarımla.