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ış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.

[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ığınız kodları bir module şu şekilde yazı
MODÜL

Sub KopyaYap()
kodlarınız
end sub

ÇALIŞMA SAYFANIZ

private sub Worksheet_Activate()
Call KopyaYap
End Sub

private sub Worksheet_Change()
Call KopyaYap
End Sub

şeklinde deneyiniz

[SeSi]

Sayın hsayar,

Bunu daha önce denemiştim. Bu durumda makro sürekli çalışıyor.
Bir hücre değişikliği yaptığımda, sayfa kilitleniyor. ESC ile durdurabiliyorum.

[hsayar]

bilemiyorum

[baris74]

Arkadaþlar c ve d sütunundaki hücrelerde deðerler var ben bunlarý kopyamak istiyorum fakat sütunlarda düzensiz sýfýrlar var onlarýn kopyalanmasýný istemiyorum.
Kopyalama iþleminden sonra verilerimi baþka programa yapýþtýracam bana bu konuda makro yazarak yardýmcý olabilirmisiniz

Teþekkürler

[baris74]

yardýmcý olacak yokmu

[Mx@Raid]

Sub Kopyala()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s1.Range("A2,A4,A6,A8,A10").Select
Selection.Copy
s2.Select
s2.Range("A1").Select
ActiveSheet.Paste
s1.Select
s1.Range("2:2,4:4,6:6,8:8,10:10").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End Sub

Bu yöntemdeki A2 ile A10 arasýndaki hücrelerin hepsini tek tek yazmak yerine satýr atlayarak a10'a kadar
nasýl tanýmlayabilirim.

Yine 2:2 ile 10:10 arasýný tek tek yazmak yerine 2:2 ile 10:10 arasýnda nasýl
bir uygulmadan sonra 10:10 yazabilirim. Verdiðim bu örnek kýsa aralýklar içeriyor.

Aslýnda D2 ile D3600 arasýnda deðerleri seçmem gerekiyor ki bu da oldukça zor bir iþ.

Ýþlem yapacaðým hücre aralýðý d2'den d3600'e kadar, Yine 2:2 ile 3600:3600 aralýðýný
kulanacaðým; yalnýz örnekte de verdiðim gibi birer satýr atlayarak hücre seçmem gerekiyor.(D2: D3600) uygulmasý
benim iþimi çözecek bir sonuç deðil çünkü iki aralýk içerisinde bütün hücreleri seçmek deðil amacým.

Neden bu kadar satýr var diyecek olursanýz normalde 1800 kiþinin listesi mevcut
ama dosyayý hazýrlayan arkadaþ pdf olarak göndermiþ hazýrladýðý tabloda isim soyisimleri alt alta yazmýþ Excel'e dönüþtürdükten
sonra soyisimlerin yer aldýðý hücreleri kopyalayýp baþka bir sayfaya aktardýktan sonra boþalan hücreleri silip isimlerinin
yanýndaki hücreye aktarmam istendi; e haliyle tek tek o kadar hücreyi seç, kopyala, yapýþtýr oldukça uzun zaman isteyen iþlem bunun
yerine makro nasýl olur düþüncesiyle bu yöntemi uygulamak istiyorum ki, elimde belirttiðim oranda en az 10 dosya var. Ýþin içinden
çýkamayýnca forumdaki arkadaþlardan yardýmla çözebilirim umuduyla konu hakkýnda araþtýrdým ama ya bilgi yetersizliði ya da tamda benim
isteðim sonuca cevap verecek konularý göremediðim için iki üç gündür debelenip duruyorum.

Ýþin doðrusu buna en kýsa zamanda cevap alabilirsem iyi olacak.
iþi veren deyim yerindeyse ensemde boza piþiriyor.

Umarým konu hakkýnda yardýmcý olabilirsiniz.

Teþekkürler.