Soru Veri depolama hakkında yardım

[hamza2011]

Merhaba,
Ek'li örnek dosyada konuyu belirttim. Rica ediyorum lütfen yardım eder misiniz.

 

[Ömer]

Merhaba,

İsimlerin yerleri sabit ve her 2 listede de aynı olduğu düşünüldü. Eğer farklı olma durumu varsa kodları değiştirmek gerekir.

Sub depola()

    Dim S1 As Worksheet, S2 As Worksheet, sut As Integer
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    On Error GoTo atla:
    sut = WorksheetFunction.Match(S1.[C2], S2.[2:2], 0)
    
    S1.Range("D7").Resize(13, 1).Copy S2.Cells(3, sut)
    Exit Sub
atla:
    MsgBox "Tarihi Bulamadım"
    
End Sub

 

[hamza2011]

Ömer bey,
Çok teşekkür ederim harika oldu Allah razı olsun.
Fakat müsadenle bir ilave olarak ; yapıştırırken sadece değerleri yapıştırmasını istiyorum. Uğraştım yapamadım.

 

[Ömer]

Bu şekilde deneyin.

Sub depola()

    Dim S1 As Worksheet, S2 As Worksheet, sut As Integer
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    On Error GoTo atla:
    sut = WorksheetFunction.Match(S1.[C2], S2.[2:2], 0)
    
    Application.ScreenUpdating = False
    S1.Range("D7").Resize(13, 1).Copy
    S2.Cells(3, sut).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Application.CutCopyMode = False
    Exit Sub
atla:
    MsgBox "Tarihi Bulamadım"
    
End Sub

 

[hamza2011]

Tekrar teşekkür ederim.
Sağlıklı günler dilerim. Elinize sağlık.