Firma bilgilerini kopyalama için makro

[KARTAL06]

Bir sayfada yaklaşık 300 firma var. Hepsinin bir kodu ve bilgileri var. Diğer sayfada bir hücreye herhagi bir firmanın kodunu girdiğimde makro çalışınca firma bilgilerin olduğu alanın kopyalanmasını istiyorum. İlgilenen ustalara şimdiden teşekkür ederim.

 

[N.Ziya Hiçdurmaz]

Yanıt

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s2 As Worksheet
Dim sat As Integer
If Intersect(Target, Range("a5,a11")) Is Nothing Then Exit Sub
Set s2 = Sheets("Sayfa2")
For sat = 1 To s2.Cells(65536, "a").End(xlUp).Row
On Error GoTo atla
If Target Like s2.Cells(sat, "a") Then
s2.Cells(sat, "a").CurrentRegion.Copy _
Target
End If: Next
atla:
End Sub

 

[KARTAL06]

Teşekkür ederim ama bir sorun var

Herhade ben eksik anlattım. Sayfa1 de a sütununda alt alta benim seçtiğim herhangi bir hücrenin yanına kopyalamasını istiyorum. Birde butonla çalışması mümkünmü?

 

[N.Ziya Hiçdurmaz]

Yanıt

Sub aktar()
Dim s2 As Worksheet
Dim sat As Integer
Set s2 = Sheets("Sayfa2")
For sat = 1 To s2.Cells(65536, "a").End(xlUp).Row
On Error GoTo atla
If ActiveCell Like s2.Cells(sat, "a") Then
s2.Cells(sat, "a").CurrentRegion.Copy _
ActiveCell
End If: Next
atla:
End Sub

 

[KARTAL06]

İlginize teşekkür edrim Ziya bey

Şimdi kendi dosyama uygulayıp kodu anlamaya çalışacağım.

 

[alibaskan]

Sayfa1 deki kırmızı alanları değiştirdiğiniz anda çalışır. İsterseniz buton da koyabilirim. Ama böyle daha pratik gibi geldi bana. Umarım işinize yarar.

 

[KARTAL06]

Zaman ayırdığınız için teşekkür ederim

Sayfa1 deki kırmızı alanları değiştirdiğiniz anda çalışır. İsterseniz buton da koyabilirim. Ama böyle daha pratik gibi geldi bana. Umarım işinize yarar.

Ama 5 ve 6 yazdığımda çalışmıyor.

 

[alibaskan]

Sayın KARTAL06 kodlarda küçük bir hata yapmışım. Düzelttim şu an doğru çalışıyor. Dosyanın yeni hali ektedir.

 

[KARTAL06]

İlginize teşekkür ederim

Sayın KARTAL06 kodlarda küçük bir hata yapmışım. Düzelttim şu an doğru çalışıyor. Dosyanın yeni hali ektedir.

Evet şimdi çalışıyor. Örneğinizi bir alternatif olarak kaydettim.

 

[alibaskan]

Rica ederim.