Verinin Kalıcı olarak diğer sayfaya işletmek

[seyfi38]

Uzmanlar merhaba
yinebir excel yardımı ile karşınızdayım
bir sayfa üzerindeki bazı bilgilerin diğer sayfaya kalıcı olarak aktarmak istiyoruz
yardımcı olması bakımından dosyayı ekliyorum
şimdiden yardımlarınıza tesekkürler

Arama Yaptım buna göre bir konu bulamadım

 

[seyfi38]

Uzman arkadaşlar
yardımlarınızı bekliyorum
galiba siz bu konuyu okumadınız

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz. Eksik yönleri varsa belirtin düzeltmeye çalışalım.

Kullanılan kod;

Option Explicit
 
Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, SÜTUN As Byte, SATIR As Long, BUL As Range
 
    Set S1 = Sheets("Teminat Alımı")
    Set S2 = Sheets("Rapor")
    Set S3 = Sheets("Teminat Ödemesi")
 
    If ActiveSheet.Name = S1.Name Then
        If S1.Range("H4") <> "" Then
 
        If WorksheetFunction.Trim(S1.Range("H4")) = "GEÇİCİ TEMİNAT ALINMASI BANKA" Then SÜTUN = 3
        If WorksheetFunction.Trim(S1.Range("H4")) = "GEÇİCİ TEMİNAT ALINMASI NAKİT" Then SÜTUN = 4
        If WorksheetFunction.Trim(S1.Range("H4")) = "KESİN TEMİNAT ALINMASI BANKA" Then SÜTUN = 5
        If WorksheetFunction.Trim(S1.Range("H4")) = "KESİN TEMİNAT ALINMASI NAKİT" Then SÜTUN = 6
 
        SATIR = IIf(S2.Range("B65536").End(3).Row = 9, S2.Range("B65536").End(3).Row + 2, S2.Range("B65536").End(3).Row + 1)
 
        S2.Cells(SATIR, "B") = S1.Range("H7")
        S2.Cells(SATIR, SÜTUN) = S1.Range("F6")
        If InStr(1, Trim(S1.Range("H4")), "GEÇİCİ") > 0 Then
        S2.Cells(SATIR, "G") = S1.Range("D12")
        S2.Cells(SATIR, "H") = S1.Range("E12")
        Else
        S2.Cells(SATIR, "I") = S1.Range("D12")
        S2.Cells(SATIR, "J") = S1.Range("E12")
        End If
        End If
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    ElseIf ActiveSheet.Name = S3.Name Then
        If S3.Range("H4") <> "" Then
 
        If WorksheetFunction.Trim(S3.Range("H4")) = "GEÇİCİ TEMİNAT ÖDENMESİ BANKA" Then SÜTUN = 14
        If WorksheetFunction.Trim(S3.Range("H4")) = "GEÇİCİ TEMİNAT ÖDENMESİ NAKİT" Then SÜTUN = 15
        If WorksheetFunction.Trim(S3.Range("H4")) = "KESİN TEMİNAT ÖDENMESİ BANKA" Then SÜTUN = 16
        If WorksheetFunction.Trim(S3.Range("H4")) = "KESİN TEMİNAT ÖDENMESİ NAKİT" Then SÜTUN = 17
 
        Set BUL = S2.Range("B11:B65536").Find(S3.Range("H7"))
        If Not BUL Is Nothing Then
 
        S2.Cells(BUL.Row, SÜTUN) = S3.Range("F6")
        If InStr(1, Trim(S3.Range("H4")), "GEÇİCİ") > 0 Then
        S2.Cells(BUL.Row, "R") = S3.Range("D12")
        S2.Cells(BUL.Row, "S") = S3.Range("E12")
        Else
        S2.Cells(BUL.Row, "T") = S3.Range("D12")
        S2.Cells(BUL.Row, "U") = S3.Range("E12")
        End If
        Else
        MsgBox S3.Range("H7") & " nolu ihale bulunamamıştır !", vbExclamation
        GoTo Son
        End If
        End If
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
Son:
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
End Sub

 

[seyfi38]

Sayın Korhan Ayhan
öncelikle ilginize ve bilginize teşekkürler
Muhteşem olmuş tek eksiği
geri ödemelerde ihale numarasına göre alımın karşısına işlemesini istiyoruz
ödemeleride sıraya göre düzenliyor
acebe hangi ihalenin ödemesi ise onun geri ödemesi olarak karşı satırına yazdırabilirmiyiz
Örneğin
2009/163768 ihale no ile 950 tl almışız Geri ödeme makbuzuna yazınca alınanın karşı satırında farklı tarihle ödeme yapmışız görebilirmiyiz
Örnekli anlatımı ektedir.

Selamlar

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki dosyayı ve kodu güncelledim. İncelermisiniz.

 

[seyfi38]

Sayın Korhan Ayhan
Çözümünüz için teşekkürler

Selamlar
Not (mümkünse Açılır kutudaki karekteri nasıl büyütebilirim yanıtlarsan sevinirrim)

 

[Korhan Ayhan]

Selamlar,

Açılır kutu karakterlerini büyütemezsiniz. Sadece sayfanızın zoom ayarlarını arttırarak daha büyük karakterler gösterebilirsiniz.