Seçili hücreyi kopyalama

[sezer32]

Merhaba

Herhangi bir hücreye tıklayınca o hücredeki veriyi diğer sayfadaki j16 hücresine kopyalama yapmak istiyorum..Dolanbaçlı da olsa formülle bişeyler yazılabilirse daha iyi olur..

Mümkün değilse aşağıdaki butona tıklayınca veriyi hedef sayfadaki hücreye veriyi kopyalıyor ama o sayfa açsın istiyorum..Teşekkürler şimdiden..

Private Sub CommandButton1_Click()
Selection.Copy
Sheets("ANLZ (2)").Range("j16").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub

 

[numan şamil]

Merhaba

Private Sub CommandButton1_Click()
Selection.Copy
Sheets("ANLZ (2)").Range("j16").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("ANLZ (2)").Range("j16").Select
End Sub

 

[numan şamil]

Merhaba
Seçilen hücre başka sayfada ise
"A" ile" H" sütunları ve arasında herhangi hücre seçilirse çalışır
Denermisiniz

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [A:H]) Is Nothing Then Exit Sub
Selection.Copy
Sheets("ANLZ (2)").Range("j16").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("ANLZ (2)").Range("j16").Select
End Sub

Aynı sayfada ise

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [A:H]) Is Nothing Then Exit Sub
Selection.Copy
Range("j16").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub

 

[sezer32]

Merhaba
Seçilen hücre başka sayfada ise
"A" ile" H" sütunları ve arasında herhangi hücre seçilirse çalışır
Denermisiniz

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [A:H]) Is Nothing Then Exit Sub
Selection.Copy
Sheets("ANLZ (2)").Range("j16").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("ANLZ (2)").Range("j16").Select
End Sub

Aynı sayfada ise

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [A:H]) Is Nothing Then Exit Sub
Selection.Copy
Range("j16").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub

Elinize sağlık..Evet hocam başka sayfadaydı..

Veri aktardı..Kopyaladığı yer açılmadı şöyle bi hata aldım.

"Range sınıfının select yöntemi başarısız"

Notffice 2007 kullanıyorum.

 

[numan şamil]

Merhaba
Gözden kaçmış

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [A:H]) Is Nothing Then Exit Sub
Selection.Copy
Sheets("ANLZ (2)").Range("j16").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("ANLZ (2)").Select
End Sub

 

[sezer32]

Merhaba
Gözden kaçmış

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [A:H]) Is Nothing Then Exit Sub
Selection.Copy
Sheets("ANLZ (2)").Range("j16").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("ANLZ (2)").Select
End Sub

Oldu hocam çok teşekkürler..

 

[sezer32]

@numan şamil Hocam zahmet veriyorum ama aynı formülü masaüstündeki başka dosya içinde yazabilirmisiniz?

 

[sezer32]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [af:af]) Is Nothing Then Exit Sub
Workbooks.Open Filename:="c:\Sat-Kar-2017 6 V2.xlsx"
Selection.Copy
Sheets("Sat-Kar-2017 6 V2").Range("af10").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Sat-Kar-2017 6 V2").Select
End Sub

Birşeyler kurcaladım olmadı..