Soru Bir Hücredeki Veriyi Belirli Aralıkta Bulup Karşısındaki Hücreye Başka Bir Hücredeki Veriyi Kopyalayan Makro

[malitogan]

Değerli arkadaşlar, hakkediş dosyasında kaydet ile ilgili bir problemim var. Yardımcı olabilirseniz memnun olurum.
Bilgi sayfasında Kaydet butonuna basınca, Özet sayfasında AZ5 hücresindeki veriyi Özet sayfası AD5:AD40 aralığında en son boş hücreye yapıştırıyor.
Ancak benim yapmak istediğim, Bilgi sayfasında Kaydet butonuna basınca, yine Bilgi sayfasında K1 hücresindeki veriyi Özet sayfasında A5:A40 aralığında arayıp bulacak, bulduğu satırın hizasında AD5:AD40 aralığındaki hücreye AZ5 hücresindeki veriyi yapıştıracak. K1 hücresindeki veriyi Özet sayfasında A5:A40 aralığında bulamazsa ve/veya AZ hücresi boşsa hiçbir işlem yapmayacak.

Not : İşlem yapılan sayfalar şifre korumalı, verilerin yer aldığı ve işlem yapılacak hücreler birleştirilmiş hücre.

 

[malitogan]

Günaydınlar. Özür dilerim. Yardımcı olabilecek bir uzman arkadaş var mı?

 

[malitogan]

Arkadaşlar, benimle aynı problemi olan varsa eğer, sorunum aşağıdaki makro ile çözüldü. Umarım sizlerin de işine yarar.
Private Sub Kaydet()
Dim bilgi As Worksheet, ozet As Worksheet, aralik As Range
Dim ara As Range, tutar As Double, aranan As String, hcr As Range
Set ozet = Sheets("Özet")
Set bilgi = Sheets("Bilgi")
Set aralik = ozet.Range("A5:A40")
aranan = bilgi.Range("K1")
For Each hcr In aralik
If aranan = hcr Then
tutar = ozet.Range("AZ5")
If tutar = Empty Then
MsgBox "Tutar alanı boş olduğu için aktarım yapılamadı"
Exit Sub
Else
ozet.Range("AD" & hcr.Row) = tutar
GoTo 10
End If
End If
Next
Exit Sub
10:
MsgBox "Tutar aktarıldı."
End Sub

 

[mühendisberke]

Ornek_Dosya.xlsm dosyasını indir - download

Ornek_Dosya.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s2.dosya.tc

onay kısmını kaldırdım bende sorun yaptı.
onun dışında çalışıyor eğer boşsa az25 boş satır kopyalıyor ki gözükmüyor bile

iyi çalışmalar