Yardım macro ile diğer dosyadaki verileri değer olarak yapıştırmak

[ExcelCahili]

Arkadaşlar ÇEK.XLSM dosyası D sürücümde bulunmakta ve SOR.XLSM dosyasında bulunan yeşil ile işaretli satırlara ÇEK dosyasından çektirerek değer olarak yapıştırmak istiyorum. Bunu macro ile yaptırmak istiyorum. Bu konuda yardımcı olabilirseniz sevinirim. SOR ve ÇEK dosyaları örnektir ben o macroya göre kendi dosyamdaki satır ve sütunlara göre değiştireceğim. Teşekkürler..

 

[Sirius]

Arkadaşlar ÇEK.XLSM dosyası D sürücümde bulunmakta ve SOR.XLSM dosyasında bulunan yeşil ile işaretli satırlara ÇEK dosyasından çektirerek değer olarak yapıştırmak istiyorum. Bunu macro ile yaptırmak istiyorum. Bu konuda yardımcı olabilirseniz sevinirim. SOR ve ÇEK dosyaları örnektir ben o macroya göre kendi dosyamdaki satır ve sütunlara göre değiştireceğim. Teşekkürler..

aşağıdaki kod işinize yarayacaktır. sorunla karşılarsanız kodu revize ederiz.

Sub VeriCek()
    'ÇEK.XLSM dosyasının yolunu belirleyin
    Const cekDosyasi As String = "D:\ÇEK.XLSM"
    'SOR.XLSM dosyasının yolunu belirleyin
    Const sorDosyasi As String = "C:\SOR.XLSM"
    'ÇEK dosyasındaki veri hücrelerinin adreslerini belirleyin
    Const cekVeriAdres As String = "A1:A10"
    'SOR dosyasındaki hedef hücrelerin adreslerini belirleyin
    Const sorHedefAdres As String = "B1:B10"
    
    Dim cekWb As Workbook
    Dim sorWb As Workbook
    Dim cekWs As Worksheet
    Dim sorWs As Worksheet
    Dim cekVeri As Variant
    Dim sorHedef As Range
    Dim i As Long
    
    'ÇEK dosyasını açın
    Set cekWb = Workbooks.Open(cekDosyasi)
    Set cekWs = cekWb.Sheets(1)
    
    'ÇEK dosyasındaki veri hücrelerini alın
    cekVeri = cekWs.Range(cekVeriAdres)
    
    'SOR dosyasını açın
    Set sorWb = Workbooks.Open(sorDosyasi)
    Set sorWs = sorWb.Sheets(1)
    
    'Hedef hücreleri belirleyin
    Set sorHedef = sorWs.Range(sorHedefAdres)
    
    'Veriyi hedef hücrelere yapıştırın
    For i = 1 To UBound(cekVeri)
        sorHedef(i).Value = cekVeri(i, 1)
    Next i
    
    'Dosyaları kapatın
    cekWb.Close SaveChanges:=False
    sorWb.Close SaveChanges:=True
    
    MsgBox "Veriler başarıyla kopyalandı!"
End Sub