Sayfalar Arası Veri Aktarma

[kahramang1]

Merhaba arkadaşlar.
Sizden ricam ekli dosyada "giriş" sayfasında "tarih", "sıra","işin mahiyeti", ve "toplam" hücrelerindeki değeri "listele" düğmesine bastığımda "liste" sayfasına gidip, en son boş satırı bulup "tarih" i "tarih" sütununa, "sıra" yı "belge no" sütununa, "işin mahiyeti" ni "açıklama" sütununa ve "toplam" ı "tutar" sütununa yazmasıdır. Şimdiden teşekkür eder, başarılar dilerim.

 

[YUSUF44]

Dosyanızda "giriş" adlı bir sayfa yok, "liste" adlı bir sayfa da yok. Sayfa1 ve Sayfa2 var. Sayfa1'de makbuz varken, sayfa2 tamamen boş. Doğru dosyayı ekleyin inceleyelim. Ayrıca işin mahiyeti ve tutar kısmında 3 satır var bu 3 satır ayrı ayrı satırlara mı aktarılacak yoksa birleştirilip tek satır olarak mı kaydedilecek?

 

[kahramang1]

özür dilerim. Demekki yanlış dosya göndermişim. "İşin mahiyeti" kısmı birleşip tek satır olsun lütfen. Teşekkürler.

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz:

Sub aktar()
Set s1 = Sheets("giriş")
Set s2 = Sheets("liste")
uyarı = MsgBox(Format(s1.[P1], "dd/mm/yyyy") & " tarihli " & Chr(10) & _
        Format(s1.[R4], "0000") & " sıra numaralı " & Chr(10) & _
        s1.[A9] & " " & s1.[A11] & " " & s1.[A13] & " açıklamalı" & Chr(10) & _
        Format(s1.[O15], "#.###,00 TL") & "'lik makbuz kaydedilsin mi?", vbYesNo)
        If uyarı = vbYes Then
            yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
            s2.Cells(yeni, "A") = s1.[P1]
            s2.Cells(yeni, "A").NumberFormat = "dd/mm/yyyy"
            s2.Cells(yeni, "B") = s1.[R4]
            s2.Cells(yeni, "B").NumberFormat = "0000"
            s2.Cells(yeni, "C") = s1.[A9] & " " & s1.[A11] & " " & s1.[A13]
            s2.Cells(yeni, "D") = [O15]
            s2.Cells(yeni, "D").NumberFormat = "#.###,00"
        End If
    
End Sub

 

[kahramang1]

Çok teşekkür ederim yusuf44. Harika olmuş. son bir ricam kaydettikten sonra formu temizleyip, numarayı bir artırmayı da ekleyebilir miyiz acaba. Teşekkürler.

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Sub aktar()
Set s1 = Sheets("giriş")
Set s2 = Sheets("liste")
uyarı = MsgBox(Format(s1.[P1], "dd/mm/yyyy") & " tarihli " & Chr(10) & _
        Format(s1.[R4], "0000") & " sıra numaralı " & Chr(10) & _
        s1.[A9] & " " & s1.[A11] & " " & s1.[A13] & " açıklamalı" & Chr(10) & _
        Format(s1.[O15], "#.###,00 TL") & "'lik makbuz kaydedilsin mi?", vbYesNo)
        If uyarı = vbYes Then
            yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
            s2.Cells(yeni, "A") = s1.[P1]
            s2.Cells(yeni, "A").NumberFormat = "dd/mm/yyyy"
            s2.Cells(yeni, "B") = s1.[R4]
            s2.Cells(yeni, "B").NumberFormat = "0000"
            s2.Cells(yeni, "C") = s1.[A9] & " " & s1.[A11] & " " & s1.[A13]
            s2.Cells(yeni, "D") = [O15]
            s2.Cells(yeni, "D").NumberFormat = "#.###,00"
            s1.Select
            s1.[P1] = Date
            s1.[R4] = s1.[R4] + 1
            s1.[R4].NumberFormat = "0000"
            s1.[A9, A11, A13, J9, J11, J13, L9, L11, L13, O9, O11, O13] = ""
        End If
    
End Sub

 

[kahramang1]

Çok teşekkürler. Ellerinize sağlık. Gayet güzel çalıştı. Kolay gelsin.