makro ile kopyalama ve yapıştırma

[mert25]

Selam anasayfadan örneğin C1, C2 ve C3 hücre değerlerini kopyalayıp ders adlı sayfada C1, C2 ve C3 hücrelerine yapıştıracak makro lazım. Fakat makro butonla değil de ders adlı sayfa aktif olunca otomatik çalışsın. Bir şeyler yapmaya çalıştım fakat olmadı. Yardımcı olursanız memnun olurum.

 

[Hüseyin]

Merhaba,
VBA Editörde Ders sayfasının kod bölümüne aşağıdaki kodu ekleyin.

Private Sub Worksheet_Activate()
Sheets("anasayfa").Range("C1:C3").Copy
ActiveSheet.Paste Destination:=Worksheets("Ders").Range("C1:C3")
End Sub

 

[mert25]

Hüseyin bey teşekkür ederim kod güzel çalıştı. Ben C1 de =DÜÞEYARA(sayı1;personel1;2;YANLIÞ) formülünü kullanarak personel ismi yazdırıyorum. Sizin kod ders sayfasındaki ilgili hücreye formülü yazdırıyor. Formül yerine personel ismi nasıl yazdırılacxak.

 

[Hüseyin]

Selam,
şunu deneyin;

Private Sub Worksheet_Activate()
Sheets("anasayfa").Range("C1:C3").Copy
Sheets("Ders").Range("C1:C3").Select
Selection.PasteSpecial Paste:=xlPasteValues
End Sub

 

[mert25]

Hüseyin bey teşekkür ederim. Elinize sağlık.

 

[mert25]

Hüseyin bey dünkü kodu aşağıdaki şekilde kullandım. Çok güzel çalışıyor. Fakat epeyce uzun oldu. Bu kodu daha kolay yazma şekli var mıdır acaba.

Private Sub Worksheet_Activate()
If Sheets("Anasayfa").Range("A1") = "1" Then
Sheets("Personel").Range("C74").Copy 'Kurum Adı'
Sheets("Sevk").Range("C3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
End If

If Sheets("Anasayfa").Range("A1") = "1" Then
Sheets("Personel").Range("C75").Copy 'Kurum Amiri'
Sheets("Sevk").Range("D11").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
End If

If Sheets("Anasayfa").Range("A1") = "1" Then
Sheets("Personel").Range("C76").Copy 'Kurum Amirinin Unvanı'
Sheets("Sevk").Range("D12").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
End If

If Sheets("Anasayfa").Range("A1") = "1" Then
Sheets("Personel").Range("C77").Copy 'Memurun Adı Soyadı'
Sheets("Sevk").Range("C5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
End If

If Sheets("Anasayfa").Range("A1") = "1" Then
Sheets("Personel").Range("C78").Copy 'Memurun Unvanı'
Sheets("Sevk").Range("C7").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
End If

If Sheets("Anasayfa").Range("A1") = "1" Then
Sheets("Personel").Range("C79").Copy 'Hastanın Adı Soyadı'
Sheets("Sevk").Range("E5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
End If

If Sheets("Anasayfa").Range("A1") = "1" Then
Sheets("Personel").Range("C80").Copy 'Sağlık Kurumu'
Sheets("Sevk").Range("C15").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
End If

If Sheets("Anasayfa").Range("A1") = "1" Then
Sheets("Personel").Range("C81").Copy 'Tarih'
Sheets("Sevk").Range("F11").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
End If

If Sheets("Anasayfa").Range("A1") = "1" Then
Sheets("Personel").Range("C82").Copy 'Adres'
Sheets("Sevk").Range("C9").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
End If

If Sheets("Anasayfa").Range("A1") = "1" Then
Sheets("Personel").Range("C83").Copy 'T.C. Kimlik No'
Sheets("Sevk").Range("F3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
End If

If Sheets("Anasayfa").Range("A1") = "1" Then
Sheets("Personel").Range("C84").Copy 'Sicil No'
Sheets("Sevk").Range("E7").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
End If

If Sheets("Anasayfa").Range("A1") = "1" Then
Sheets("Personel").Range("C85").Copy 'Derece/Kadro'
Sheets("Sevk").Range("F7").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
End If

If Sheets("Anasayfa").Range("A1") = "1" Then
Sheets("Personel").Range("C86").Copy 'Sayı'
Sheets("Sevk").Range("F13").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False
End If
End Sub

Bir de yukarıdaki koda
If Sheets("Anasayfa").Range("A1") = "1" Then
ekelmek zorunda kaldım. Yoksa çalışmadı ya da ben çalıştıramadım. Burada A1=1 yerine A1<>"" şeklinde denedim olmadı. Yani A1 boş değilse nasıl demeliyim.

 

[Murat ÞAHİN]

If Sheets("Anasayfa").Range("A1") = 1 Then şeklinde deneytin Tırnak işaretlerini kaldırın

 

[mert25]

Murat bey benim aradığım If Sheets("Anasayfa").Range("A1") = 1 Then buradaki 1 yerine boş değilse (<>"") demek. Formülle kolay fakat makroda nasıl yapılır?

 

[donhuan]

Merhabalar;

If Sheets("Anasayfa").Range("A1").FormulaR1C1 <> "" Then

şeklinde yazarsan anasayfa daki A1 hücresi boş değilse işlem yapacaktır.
Kolay gelsin.

 

[mert25]

donhuan kardeş teşekkürler, fakat önceki soruma karşılık bulamadım. Acaba excel'de mümkün olmayan birşey mi istedim bilmiyorum.

 

[dolphin]

dostlar epeydir ayrı kaldık. cemil gökmen in veri denetimi kitabını
inceliyordum. bu arada makrolar isimli kitabıda verdi arkadaşım. oda
çok güzel. oradan öğrendiğim kadarıyla kopyala yapıştır yapmanıza
ihtiyacınız yok çünkü şöyle yapabilirsiniz.

Sheets("Sevk").Range("C3").value=Sheets("Personel").Range("C74").value

eğer böyle olursa buraya bildirinki işe yarayıp yaramadığını anlayayım.

 

[mert25]

Sayın dolphin kodunuzu şu haliyle programda kullandım. Hata vermedi. teşekkür ederim.

Private Sub Worksheet_Activate()
If Sheets("Anasayfa").Range("E8").FormulaR1C1 <> "" Then
Sheets("Sevk").[C3].Value = Sheets("Anasayfa").[Z2].Value 'Kurum Adı'
Sheets("Sevk").[D11].Value = Sheets("Anasayfa").[Z3].Value 'Kurum Amiri'
Sheets("Sevk").[D12].Value = Sheets("Anasayfa").[Z4].Value 'Kurum Amirinin Unvanı'
Sheets("Sevk").[C5].Value = Sheets("Anasayfa").[Z5].Value 'Memurun Adı Soyadı'
Sheets("Sevk").[C7].Value = Sheets("Anasayfa").[Z6].Value 'Memurun Unvanı'
Sheets("Sevk").[E5].Value = Sheets("Anasayfa").[Z7].Value 'Hastanın Adı Soyadı'
Sheets("Sevk").[C15].Value = Sheets("Anasayfa").[Z8].Value 'Sağlık Kurumu'
Sheets("Sevk").[F11].Value = Sheets("Anasayfa").[Z9].Value 'Tarih'
Sheets("Sevk").[C9].Value = Sheets("Anasayfa").[Z10].Value 'Adres'
Sheets("Sevk").[F3].Value = Sheets("Anasayfa").[Z11].Value 'T.C. Kimlik No'
Sheets("Sevk").[E7].Value = Sheets("Anasayfa").[Z12].Value 'Sicil No'
Sheets("Sevk").[F7].Value = Sheets("Anasayfa").[Z13].Value 'Derece/Kadro'
Sheets("Sevk").[F13].Value = Sheets("Anasayfa").[Z14].Value 'Sayı'
End If
End Sub

 

[Haluk]

@mert25:

Aşağıdaki biraz daha kolay bir yazım şekli....

Private Sub Worksheet_Activate()
    Set Sh1 = Sheets("Sevk")
    Set Sh2 = Sheets("Anasayfa")
        If Sh2.Range("E8").FormulaR1C1 <> "" Then
            Sh1.[C3] = Sh2.[Z2] 'Kurum Adı'
            Sh1.[D11] = Sh2.[Z3] 'Kurum Amiri'
            Sh1.[D12] = Sh2.[Z4] 'Kurum Amirinin Unvanı'
            Sh1.[C5] = Sh2.[Z5] 'Memurun Adı Soyadı'
            Sh1.[C7] = Sh2.[Z6] 'Memurun Unvanı'
            Sh1.[E5] = Sh2.[Z7] 'Hastanın Adı Soyadı'
            Sh1.[C15] = Sh2.[Z8] 'Sağlık Kurumu'
            Sh1.[F11] = Sh2.[Z9] 'Tarih'
            Sh1.[C9] = Sh2.[Z10] 'Adres'
            Sh1.[F3] = Sh2.[Z11] 'T.C. Kimlik No'
            Sh1.[E7] = Sh2.[Z12] 'Sicil No'
            Sh1.[F7] = Sh2.[Z13] 'Derece/Kadro'
            Sh1.[F13] = Sh2.[Z14] 'Sayı'
        End If
    Set Sh1 = Nothing
    Set Sh2 = Nothing
End Sub

 

[mert25]

İlgi ve yardımlarınız teşekkür ederim.

 

[dolphin]

selam raider,

kitapta henüz oraya kadar gelmedim. yakında o şekilde kod yazmayıda
öğrenirim. ama ben galiba -benzetme yanlış olabilir belki- mert e balık
tutmayı öğretmişim, sense balığı tutup vermişsin. buda benim internet
formundaki ilk yardımım olmuş oldu. bana bu daha iyi teşfik olacak.
bu siteyi kuranlara teşekkür ederim.

 

[dolphin]

ya sizin mesajlarınız niye uzun oluyorda benim satırlarım böyle boyu kısa
kalıyor.

 

[SeSi]

Kopyala yap&#305;&#351;t&#305;r makrosunun hem sayfa aktif oldu&#287;unda hem de sayfada h&#252;cre de&#287;i&#351;ikli&#287;i yap&#305;ld&#305;&#287;&#305;nda &#231;al&#305;&#351;mas&#305; i&#231;in kodu hangi b&#246;l&#252;me yazmal&#305;y&#305;m?

Te&#351;ekk&#252;rler.

 

[SeSi]

Kopyala yapıştır makrosunun hem sayfa aktif olduğunda hem de sayfada hücre değişikliği yapıldığında çalışması için kodu hangi bölüme yazmalıyım?

Teşekkürler.

Kodu "Worksheet_Activate" bölümüne yazıyorum sadece sayfa aktif olduğunda çalışıyor.

"Worksheet_Change" bölümüne yazdığımda ise sadece hücrede değişiklik olduğunda çalışıyor.

Ben hem sayfa aktif hem de hücrede değişikliği olduğunda çalışmasını istiyorum.

Teşekkürler.

 

[hsayar]

yazd&#305;&#287;&#305;n&#305;z kodlar&#305; bir module &#351;u &#351;ekilde yaz&#305;
MOD&#220;L

Sub KopyaYap()
     kodlarınız
end sub

&#199;ALI&#350;MA SAYFANIZ

private sub Worksheet_Activate()
Call KopyaYap
End Sub

private sub Worksheet_Change()
Call KopyaYap
End Sub

&#351;eklinde deneyiniz

 

[SeSi]

Say&#305;n hsayar,

Bunu daha &#246;nce denemi&#351;tim. Bu durumda makro s&#252;rekli &#231;al&#305;&#351;&#305;yor.
Bir h&#252;cre de&#287;i&#351;ikli&#287;i yapt&#305;&#287;&#305;mda, sayfa kilitleniyor. ESC ile durdurabiliyorum.