Evrak Senedi Oluşturma

[Ahmet Sami]

İyi günler diliyorum.
ANASAYFA dan giriş yapıyorum. Bazen 4 bazen 1 bazen de 25 giriş yapıyorum, sizden istediğim yardım sarı olan bölümün, satır sayısına göre otomatik olarak sayfanın altında yer alması, yani 4 giriş yaptığım zaman burada göründüğü gibi olması 20 giriş yatığım zaman 20 satır açması bilgileri buruya yazması ve 20 nci satırın altına sarı olan yeri aynen yazması.
Yardımlarınız için şimdiden teşekkür ederim.

 

[Necdet]

Merhaba,

SENET sayfasında 32 satır (daha da fazla olabilir) olacak şekilde ayarladım.
SENET sayfası aktif olduğunda ANASAYFA'daki verileri SENET sayfasına aktarıp, fazla olan boş satırları siler.

Aşağıdaki kodlar SENET sayfasının kod bölümünde olmalı.

Private Sub Worksheet_Activate()

    Dim ShA As Worksheet, _
        i   As Integer, _
        j   As Integer

    Set ShA = Sheets("ANASAYFA")
    
    Rows("6:37").EntireRow.Hidden = False

    i = Cells(Rows.Count, "C").End(3).Row
    If i < 6 Then i = 6
    Range("B6:G" & i).ClearContents

    j = ShA.Cells(Rows.Count, "E").End(3).Row
    If j < 11 Then j = 11
    ShA.Range("E11:E" & j).Copy Range("B6")
    ShA.Range("F11:I" & j).Copy Range("D6")
    i = Cells(Rows.Count, "D").End(3).Row
    If i < 6 Then i = 6
    Range("C6:C" & i) = Range("F3")
    Rows(i + 1 & ":" & 37).EntireRow.Hidden = True

    
End Sub

 

[Ahmet Sami]

Necdet bey çok teşekkür ederim. Soğolun emeğinize sağlık.

 

[Ahmet Sami]

Necdet bey kurusa bakmayın rahatsız ediyorum ama aktarma işlemini direkt olarak yapsa SENET sayfasına gitmeden yapsa daha güzel olur bu konuda yardımcı olursanız sevinirim. SENET sayfasına gitmeden girdiğim verileri aktırmıyor. Çünkü ANASAYFA dan yazdır butonu koyarak direkt SENET sayfasını güncelleyerek yazdırmasını istiyorum.

 

[Ahmet Sami]

Yardım edebilecek bir arkadaşımız var mı?

 

[muhasebeciyiz]

Sayın Ahmet Sami ; Necdet hocamız çok güzel sorunuza çözüm üretip dosyayı ilişikte sunmuş.
Anasayfadan giriş yapıyorsun bu kadar. Senet sayfasına gitmenize gerek yok.Aktarım zaten otomatik yapılmaktadır.
Yazdırmak istersenizde senet sayfasına gidip excel menüsünden yazdıra basın bu kadar.
veya aşağıdaki kodu butona bağlayınız


Sub Makro2()
Sheets("SENET").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End Sub

 

[Necdet]

Merhaba,

Aşağıdaki kodlar bir modülde olmalı.

Sub Aktar()

    Dim ShA As Worksheet, _
        ShS As Worksheet, _
        i   As Integer, _
        j   As Integer

    Set ShA = Sheets("ANASAYFA")
    Set ShS = Sheets("SENET")
    
    ShS.Rows("6:37").EntireRow.Hidden = False

    i = ShS.Cells(Rows.Count, "C").End(3).Row
    If i < 6 Then i = 6
    ShS.Range("B6:G" & i).ClearContents

    j = ShA.Cells(Rows.Count, "E").End(3).Row
    If j < 11 Then j = 11
    ShA.Range("E11:E" & j).Copy ShS.Range("B6")
    ShA.Range("F11:I" & j).Copy ShS.Range("D6")
    i = ShS.Cells(Rows.Count, "D").End(3).Row
    If i < 6 Then i = 6
    ShS.Range("C6:C" & i) = ShS.Range("F3")
    ShS.Rows(i + 1 & ":" & 37).EntireRow.Hidden = True

    ShS.PrintOut
    
End Sub

 

[Ahmet Sami]

Necdet bey sağolun bir şey unutmuşum SENET sayfası gizli olması gerekiyordu gizli olarak yazdırdım hata verdi nasıl düzeltebilirim. Sizi de yoruyorum hakkınızı helal edin

 

[Necdet]

Aşağıdaki gibi kullanın.

Sub Aktar()

    Dim ShA As Worksheet, _
        ShS As Worksheet, _
        i   As Integer, _
        j   As Integer

    Application.ScreenUpdating = False
    
    Set ShA = Sheets("ANASAYFA")
    Set ShS = Sheets("SENET")
    
    ShS.Rows("6:37").EntireRow.Hidden = False

    i = ShS.Cells(Rows.Count, "C").End(3).Row
    If i < 6 Then i = 6
    ShS.Range("B6:G" & i).ClearContents

    j = ShA.Cells(Rows.Count, "E").End(3).Row
    If j < 11 Then j = 11
    ShA.Range("E11:E" & j).Copy ShS.Range("B6")
    ShA.Range("F11:I" & j).Copy ShS.Range("D6")
    i = ShS.Cells(Rows.Count, "D").End(3).Row
    If i < 6 Then i = 6
    ShS.Range("C6:C" & i) = ShS.Range("F3")
    ShS.Rows(i + 1 & ":" & 37).EntireRow.Hidden = True

    ShS.Visible = True
    ShS.PrintOut
    ShS.Visible = False
    
    Application.ScreenUpdating = True
    
End Sub

 

[Ahmet Sami]

Necdet bey çok teşekkür ederim. Size zahmet verdik kusurumuza bakmayın.

 

[Necdet]

Rica ederim, güle güle kullanınız.