Hücre Aktarma

[Yesilyurtlu]

Değerli Üstadlarım bir konuda yardımlarınıza ihtiyacım var.
Sayfa2 de ki
D6 Hücresini (D6 :O6 hücresine kadar Birleştirilmiştir bu hücre) ARŞİV sayfasında B2 hücresine

L7 Hücresini (L7:O7 hücresine kadar Birleştirilmiştir bu hücre) ARŞİV sayfasında C2 hücresine

D8 Hücresini (D8 :Q9 hücresine kadar Birleştirilmiştir bu hücre) ARŞİV sayfasında D2 hücresine

A11 Hücresini (A11 :AD11 hücresine kadar Birleştirilmiştir bu hücre) ARŞİV sayfasında E2 hücresine

A12 Hücresini (A12 :AD12 hücresine kadar Birleştirilmiştir bu hücre) ARŞİV sayfasında F2 hücresine

D14 Hücresini (D14 :AD14 hücresine kadar Birleştirilmiştir bu hücre) ARŞİV sayfasında G2 hücresine

A16 Hücresini (A16 :AD16 hücresine kadar Birleştirilmiştir bu hücre) ARŞİV sayfasında H2 hücresine

P49 Hücresini (P49 :AD49 hücresine kadar Birleştirilmiştir bu hücre) ARŞİV sayfasında I2 hücresine


aktarmak istiyorum.Her aktar dediğimde ARŞİV sayfasında altalta kayıt etmeli.

Yardımcı olabilir misiniz?

 

[Ömer]

Merhaba,

Sorunuzu destekleyen basit bir dosya eklermisiniz..

.

 

[Yesilyurtlu]

Ömer Abi Örnek ekledim.

Sadece Sarı renkli olan yerleri ilk mesajımda arzetmiştim.

 

[Ömer]

Module kopyalayarak çalıştırınız..

Sub HücreAktar()
 
    Dim son As Long
 
    With Sheets("ARŞİV")
    son = .Cells(Rows.Count, "B").End(xlUp).Row + 1
        .Range("A" & son) = son - 1
        .Range("B" & son) = Range("D6")
        .Range("C" & son) = Range("L7")
        .Range("D" & son) = Range("D8")
        .Range("E" & son) = Range("A11")
        .Range("F" & son) = Range("A12")
        .Range("G" & son) = Range("A16")
        .Range("H" & son) = Range("D14")
        .Range("I" & son) = Range("P49")
    End With
 
End Sub

.

 

[Yesilyurtlu]

Ömer Abi;
Allah Razı olsun. Teşekkür Ederim. Eline Sağlık.