Birleşik Hücrelerden Tek Hücreye Veri Çekme

[naz1f]

https://www.dosyaupload.com/2MakC/aa.xlsx

Örnek yüklediğim excel dosyasına bi makro yapmak istiyorum.. Sayfa1 de yazan verileri o makroyu çalıştırdığımda Arşiv sayfasına ilgili sütunlara otomatik alması için ama yapamadım.. Yani sayfa1 de yaptığım değişiklikleri istediğim zaman makro ile arşiv sayfasındaki listenin en altına almak istiyorum.. Örnek olarak biraz el ile doldurdum arşiv sayfasını.. Bu arada Sayfa1 deki liste tam dolmadan da diğer sayfaya atmam gerekebiliyor.. Yani liste dolu olmasa da dolu hücreleri almasını istiyorum.. Yardımcı olabilir misiniz?*..

 

[naz1f]

Makrolardan anlayan biri bakabilir mi acaba..

 

[askm]

Aşağıdaki kodları deneyin.

Sub askm()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("ARŞİV")
Dim son1 As Long, son2 As Long, gson2 As Long
son1 = s1.Range("C" & Rows.Count).End(3).Row
son2 = s2.Range("B" & Rows.Count).End(3).Row + 1

gson2 = son1 - 9

tarih = s1.Range("H6")
s2.Range("A" & son2 & ":A" & son2 + gson2).Merge
s2.Cells(son2, 1) = tarih

s1.Range("C9:C" & son1).Copy
s2.Cells(son2, 2).PasteSpecial Paste:=xlPasteValues

s1.Range("H9:H" & son1).Copy
s2.Cells(son2, 3).PasteSpecial Paste:=xlPasteValues

s1.Range("K9:K" & son1).Copy
s2.Cells(son2, 4).PasteSpecial Paste:=xlPasteValues

s1.Range("M9:M" & son1).Copy
s2.Cells(son2, 5).PasteSpecial Paste:=xlPasteValues


s1.Range("N9:N" & son1).Copy
s2.Cells(son2, 6).PasteSpecial Paste:=xlPasteValues


Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[naz1f]

Çok teşekkür ederim @askm bey.. Tam olarak istediğim yerlere uyguladı makro elinize sağlık..