[Çözüldü] Seçili alana göre makro

[kelkitli]

Selamlar,
Satır aralığı B:S
Sütun Aralığı 2:10
B2 ye çift tklayınca makro çalıştırılıp B2:S2 kopyalanıp B12:S12(Tüm veriler için B12:S12aralığı kullanılacak) yapıştırılacak.
B3 e çift tıklayınca makro çalıştırılıp B3:S3 kopyalanıp B12:S12 yapıştırılacak.
B3 e çift tıklayınca makro çalıştırılıp B3:S3 kopyalanıp B12:S12 yapıştırılacak.
B4 e çift tıklayınca makro çalıştırılıp B4:S4 kopyalanıp B12:S12 yapıştırılacak.

[Hüseyin Çoban]

Merhaba, ekteki örnek dosyayı inceleyiniz.

Boş bir modüle aşağıdaki kodları yapıştırın.

Kod: [Seç]

Sub b2_s2()
 Range("B2:S2").Copy
    Range("B12").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

Sub b3_s3()
 Range("B3:S3").Copy
    Range("B12").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub


Sub b4_s4()
 Range("B4:S4").Copy
    Range("B12").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub
Sayfanın kod bölümüne aşağıdaki kodları yapıştırın.

Kod: [Seç]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("b2")) Is Nothing Then
Call b2_s2

ElseIf Not Intersect(Target, Range("b3")) Is Nothing Then
Call b3_s3

ElseIf Not Intersect(Target, Range("b4")) Is Nothing Then
Call b4_s4

End If
End Sub

[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

[kelkitli]

Hüseyin Bey, çok teşekkür ederim.

[assenucler]

Sayın Hüseyin Çoban;

Merhaba.. Katkınız için en içten teşekkürler..

Sevgi ve saygılar..