Bul ve Aktar

[ormann]

İyi günler ;
Ekli örnek dosyada emval sayfasında C5 hücresine istif numarasını verdiğimde ve v2 ve v3 hücresine adet ve miktarını girdiğimde aktar butonuna bastığımda ilgili verileri istif sayfasında D9500 hücre aralığındaki aynı istif numarası yazılı olan hücre karşılığına gelecek şekilde (Adet-m3) aktarıp; H sütünun da ise GLOBAL yazısını sildirebilir miyiz. ?.Aktarmadan önce ....nolu global istif bulundu gerçekleştirmek istiyor musunuz diye bir uyarı verdirebilir miyiz?

İndir ÖRNEK

Dosyayı indir ÖRNEK

dosya.co

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub YuvarlatılmışDikdörtgen1_Tıklat()

    Dim sor As String, c As Range, Si As Worksheet
    
    Set Si = Sheets("İSTİF")
    
    Application.ScreenUpdating = False
    
    Set c = Si.[D:D].Find(Range("C5"), , xlValues, xlWhole)
    If Not c Is Nothing Then
        sor = MsgBox(Range("C5") & " nolu global istif bulundu gerçekleştirmek istiyor musunuz", vbYesNo, Range("C5") & "Devam Edeyim mi?")
        If sor = vbYes Then
            Si.Cells(c.Row, "E") = Range("V2")
            Si.Cells(c.Row, "F") = Range("V2")
            Si.Cells(c.Row, "H").ClearContents
        End If
    End If
    Si.Select
            
End Sub

 

[Ziynettin]

Alternatif olarak.

Sub aktar()
Set s1 = Sheets("İSTİF")
Set s2 = Sheets("EMVAL")
Set dc = CreateObject("scripting.dictionary")
son = s1.Cells(Rows.Count, 4).End(3).Row
    If son > 8 Then
        a = s1.[D9].Resize(son).Value
        For i = 1 To UBound(a)
        dc(CStr(a(i, 1))) = i
        Next i
    End If
    istif = CStr(s2.[C5])
    If dc(istif) > 0 Then
        If MsgBox(CStr(s2.[C5]) & " nolu istif kayıtlarda mevcut." & vbLf & vbLf & _
            " kayıt işlemi yapılsın mı?", vbInformation + vbYesNo) = vbYes Then
            s1.Cells(dc(istif) + 8, 5) = s2.[V2]
            s1.Cells(dc(istif) + 8, 6) = s2.[V3]
            s1.Cells(dc(istif) + 8, 8) = Empty
        End If
    Else
        MsgBox CStr(s2.[C5]) & " nolu istif kayıtlarda bulunamdı", vbCritical
    End If
End Sub

 

[ormann]

Sayın Ömer bey ve Sayın Ziynettin bey çok teşekkür ederim.Ellerinize sağlık