Değer karşılaştırıp sayfalar arası veri transferi

[muysun35]

Merhaba;
Konu Eski Konu linkinde açıldı ancak dosyanın karmaşık olması nedeniyle çözüm bulunamadı, Linkteki konu çöpe taşınabilir.
Sadeleştirilmiş dosya ve açıklamaları ekledim.
Yardımcı olacak arkadaşlara şimdiden teşekkürler.
Örnek Dosya

 

[Korhan Ayhan]

Merhaba,

Verilerinizi yedekleyip aşağıdaki kodu deneyiniz.

Option Explicit

Sub Lot_Miktarlarini_Guncelle()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object, Aranan As String
    Dim Son As Long, Veri As Variant, X As Long, Say As Long, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("SKP")
    Set S2 = Sheets("GCKS")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    
    Veri = S1.Range("A2:G" & Son).Value
    
    ReDim Liste(1 To Son, 1 To 1)
    
    For X = LBound(Veri) To UBound(Veri)
        Aranan = Veri(X, 1) & "|" & Veri(X, 2) & "|" & Veri(X, 6)
        If Not Dizi.Exists(Aranan) Then
            Say = Say + 1
            Dizi.Add Aranan, Say
            Liste(Say, 1) = Veri(X, 7)
        End If
    Next
    
    Son = S2.Cells(S2.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    
    Veri = S2.Range("A2:D" & Son).Value
    
    For X = LBound(Veri) To UBound(Veri)
        Aranan = Veri(X, 1) & "|" & Veri(X, 2) & "|" & Veri(X, 3)
        If Dizi.Exists(Aranan) Then
            Liste(Dizi.Item(Aranan), 1) = Veri(X, 4)
        End If
    Next
    
    If Dizi.Count > 0 Then S1.Range("G2").Resize(Dizi.Count) = Liste
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
    
    MsgBox "LOT miktarları güncellenmiştir." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[muysun35]

Üstadım eline emeğine bilgine sağlık. Çok teşekkür ederim.