• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro yardımı

M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
840
Excel Vers. ve Dili
Office 2016 TR
Merhabalar,

Makro yardımı ile aynı sayfa içerisinde bir tablodan diğer tabloya belli hücrelerdeki değerleri tablonun tarihine göre diğer tabloda ki ilgili tarih kısmına yazdırmak için ne yapmam gerek.

Teşekkürler
 

Ekli dosyalar

Dosyanızı dosya.tc gibi bir siteye upload ederseniz yardımcı olmaya çalışayım
 
Merhaba ; aşağıdaki kodu dener misiniz ?
Kod: 
Sub VeriyeGoreKopya()
    Dim Bul As Range
    
    Set Bul = Range("K:K").Find(Range("$D$3"), , , xlWhole)
    If Not Bul Is Nothing Then
    Range("[COLOR="Red"]C6:G6[/COLOR]").Copy
            Cells(Bul.Row, "L").Select
            ActiveSheet.Paste
            
            End If
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Son düzenleme:
Merhaba.

Umarım yanlış anlaşılmıyorumdur.
Sayın TEGCreative'nin verdiği kod'u aşağıdaki şekilde değiştirince sonuç yine aynı olur.
Select veya Activate gibi kod satırlarını mümkün olduğunca kullanılmaması yerinde olur diye düşünüyorum.
.
Kod: 
[FONT="Arial Narrow"]Sub VeriyeGoreKopya()
Dim Bul As Range
Set Bul = Range("K:K").Find(Range("$D$3"), , , xlWhole)
If Not Bul Is Nothing Then Range("C6:G6").Copy Cells(Bul.Row, "L")
MsgBox "İşleminiz tamamlanmıştır.", vbInformation, "[COLOR="Navy"][B]TEGCreative[/B][/COLOR]"
End Sub[/FONT]
 
Son düzenleme:
Sayın Ömer Hocam ; arkamı toplamanız hoşuma gidiyor bi yandan :) Yanlış anlamayın sakın. Bir sorum olacak bu konuda. activate yada select kodları ne gibi sıkıntı yaratır ? Pek o noktalarda bilgim yok. Vba'yı sadece araştırmalarım sonucu biliyorum ve örneklemelerimden yola çıkarak arkadaşlara yardım etmeye çalışıyorum. Olurda bi gün bi arkadaş'a bu tarz bir noktada yanlış bir işlem yaptırtmak istemem bu yüzden bi öğretirseniz bana bu işi sevinirim :)

Birde ek olarak kod üzerinde yapıştırma işlemi için bir şey yok nasıl yapıştırıyor orasını çözemedim :) kopyalıyor fakat yapıştırma ile alakalı birşey göremedim. Bunu excel otomatik olarak mı yapıyor
 
Estağfurullah, öğretmek fazla iddialı olur.
Tecrübe aktarmak denilebilir en fazla.

Copy BOŞLUK adres ENTER
bu yöntem yanlış hatırlamıyorsam DOS ortamındaki komutlar zamanından beri var.

Özellikle select için şunu söyleyeyim.
Select ile hücre seçmeyi öngördüğünüzde, ilgili sayfanın da aktif sayfa olması gerekir.
Bir'den fazla sayfada işlem yapan kod oluşturulduğunda,
-- alan.seç
-- alan kopyala
-- yapıştırılacak sayfa.activate
-- yapıştırılacak hücre.select
-- yapıştır
-- son olarak da ponoyu boşalt
işlemleri yerine (kırmızı kısım)
tek satırlık kod ile (mavi satır)
bu işlem gerçekleşebilir.
.
Kod: 
Sub KOPYALA()
[COLOR="blue"]Sheets("Sayfa[B]1[/B]").Range("A2:B4").Copy Sheets("Sayfa[B]2[/B]").Range("A2")[/COLOR]

[COLOR="Red"]Sheets("Sayfa[B]1[/B]").Range("A2:B4").Copy
Sheets("Sayfa[B]2[/B]").Activate
Sheets("Sayfa[B]2[/B]").Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False[/COLOR]
End Sub
 
Son düzenleme:
Ömer BARAN' Alıntı:
Estağfurullah, öğretmek fazla iddialı olur.
Tecrübe aktarmak denilebilir en fazla.

Copy BOŞLUK adres ENTER
bu yöntem yanlış hatırlamıyorsam DOS ortamındaki komutlar zamanından beri var.

Özellikle select için şunu söyleyeyim.
Select ile hücre seçmeyi öngördüğünüzde, ilgili sayfanın da aktif sayfa olması gerekir.
Bir'den fazla sayfada işlem yapan kod oluşturulduğunda,
-- alan.seç
-- alan kopyala
-- yapıştırılacak sayfa.activate
-- yapıştırılacak hücre.select
-- yapıştır
-- son olarak da ponoyu boşalt
işlemleri yerine (kırmızı kısım)
tek satırlık kod ile (mavi satır)
bu işlem gerçekleşebilir.
.
Kod: 
Sub KOPYALA()
[COLOR="blue"]Sheets("Sayfa[B]1[/B]").Range("A2:B4").Copy Sheets("Sayfa[B]2[/B]").Range("A2")[/COLOR]

[COLOR="Red"]Sheets("Sayfa[B]1[/B]").Range("A2:B4").Copy
Sheets("Sayfa[B]2[/B]").Activate
Sheets("Sayfa[B]2[/B]").Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False[/COLOR]
End Sub
Genişletmek için tıkla ...

Gerçekten kod kalabalığını azaltmak için muhteşem yöntem.Teşekkürler hocam.
 
O kodun özel yapıştır yöntemi de var mı acaba? Örneğin sadece değerleri tek satırda yapıştırabilir miyiz?
 
Merhaba.

Başka şekillerde de çözümü vardır sanırım ama benim tercihim;
-- verinin alınacağı ve aktarılacağı adres birer hücre ise, copy -> pastespecial) yerine mavi olan satır gibi,
-- öyle değilse de,
.... bir'den fazla kod satırını : karakteriyle (aslında işlem tek işlem değil,
sadece görüntüde tek satır) birleştirerek tek satırmış gibi (ilk kırmızı satır)
.... veya eşit alanlar arasında yapıştırma yapılacaksa da ikinci kırmızı satır gibi yazmak olur.
Kod: 
[FONT="Arial Narrow"][COLOR="Blue"]Sheets("Sayfa2").[H1] = Sheets("Sayfa1").[R14][/COLOR]
[COLOR="Red"]Sheets("Sayfa1").[R11:R14].Copy[B][COLOR="Black"]:[/COLOR][/B] Sheets("Sayfa2").[H1].PasteSpecial Paste:=xlPasteValues
[COLOR="Black"]veya[/COLOR]
Sheets("Sayfa2").[H1:H4].Value = Sheets("Sayfa1").[R11:R14].Value
[/COLOR][/FONT]
Ayrıca; copy -> paste/paste special yerine diğer yöntemin (hücre/hücre aralığı = hücre/hücre aralığı yöntemi) asıl farkının
kod'un çalışma hızı olacağını düşünüyorum, büyük veri yığınlarında deneyerek görmek gerek sanırım.
.
 
Son düzenleme:
TEGCreative' Alıntı:
Merhaba ; aşağıdaki kodu dener misiniz ?
Kod: 
Sub VeriyeGoreKopya()
    Dim Bul As Range
    
    Set Bul = Range("K:K").Find(Range("$D$3"), , , xlWhole)
    If Not Bul Is Nothing Then
    Range("[COLOR="Red"]C6:G6[/COLOR]").Copy
            Cells(Bul.Row, "L").Select
            ActiveSheet.Paste
            
            End If
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

Ömer BARAN' Alıntı:
Merhaba.

Umarım yanlış anlaşılmıyorumdur.
Sayın TEGCreative'nin verdiği kod'u aşağıdaki şekilde değiştirince sonuç yine aynı olur.
Select veya Activate gibi kod satırlarını mümkün olduğunca kullanılmaması yerinde olur diye düşünüyorum.
.
Kod: 
[FONT="Arial Narrow"]Sub VeriyeGoreKopya()
Dim Bul As Range
Set Bul = Range("K:K").Find(Range("$D$3"), , , xlWhole)
If Not Bul Is Nothing Then Range("C6:G6").Copy Cells(Bul.Row, "L")
MsgBox "İşleminiz tamamlanmıştır.", vbInformation, "[COLOR="Navy"][B]TEGCreative[/B][/COLOR]"
End Sub[/FONT]
Genişletmek için tıkla ...

Merhaba,

Yardımlarınız için teşekkür ederim. Verdiğiniz kodları uygulayamadım. http://s6.dosya.tc/server7/ofiufk/ornek1.rar.html

Teşekkür ederim.
 

Ekli dosyalar

Son düzenleme:
Ömer BARAN' Alıntı:
Merhaba.

Başka şekillerde de çözümü vardır sanırım ama benim tercihim;
-- verinin alınacağı ve aktarılacağı adres birer hücre ise, copy -> pastespecial) yerine mavi olan satır gibi,
-- öyle değilse de,
.... bir'den fazla kod satırını : karakteriyle (aslında işlem tek işlem değil,
sadece görüntüde tek satır) birleştirerek tek satırmış gibi (ilk kırmızı satır)
.... veya eşit alanlar arasında yapıştırma yapılacaksa da ikinci kırmızı satır gibi yazmak olur.
Kod: 
[FONT="Arial Narrow"][COLOR="Blue"]Sheets("Sayfa2").[H1] = Sheets("Sayfa1").[R14][/COLOR]
[COLOR="Red"]Sheets("Sayfa1").[R11:R14].Copy[B][COLOR="Black"]:[/COLOR][/B] Sheets("Sayfa2").[H1].PasteSpecial Paste:=xlPasteValues
[COLOR="Black"]veya[/COLOR]
Sheets("Sayfa2").[H1:H4].Value = Sheets("Sayfa1").[R11:R14].Value
[/COLOR][/FONT]
Ayrıca; copy -> paste/paste special yerine diğer yöntemin (hücre/hücre aralığı = hücre/hücre aralığı yöntemi) asıl farkının
kod'un çalışma hızı olacağını düşünüyorum, büyük veri yığınlarında deneyerek görmek gerek sanırım.
.
Genişletmek için tıkla ...

Teşekkürler bilgi için.

Kod: 
Sheets("Sayfa1").[R11:R14].Copy: Sheets("Sayfa2").[H1].PasteSpecial Paste:=xlPasteValues
Bu kodda seçime gerek olmadan yapıştırabiliyoruz anladığım kadarıyla değil mi?
 
Ömer BARAN' Alıntı:
Merhaba.

Umarım yanlış anlaşılmıyorumdur.
Sayın TEGCreative'nin verdiği kod'u aşağıdaki şekilde değiştirince sonuç yine aynı olur.
Select veya Activate gibi kod satırlarını mümkün olduğunca kullanılmaması yerinde olur diye düşünüyorum.
.
Kod: 
[FONT="Arial Narrow"]Sub VeriyeGoreKopya()
Dim Bul As Range
Set Bul = Range("K:K").Find(Range("$D$3"), , , xlWhole)
If Not Bul Is Nothing Then Range("C6:G6").Copy Cells(Bul.Row, "L")
MsgBox "İşleminiz tamamlanmıştır.", vbInformation, "[COLOR="Navy"][B]TEGCreative[/B][/COLOR]"
End Sub[/FONT]
Genişletmek için tıkla ...

Merhaba,

Verdiğiniz kodları uyguladım ancak "C" hücresinde formül olduğu için "L" hücresine değeri getirmiyor. Verdiğiniz kodlarda "L" hücresine sadece değerleri yapıştırmak için ne gibi değişiklik yapmak gerek.

Teşekkür ederim.
 
Tekrar merhaba.

En iyisi aşağıdaki kodu kullanın.
.
Kod: 
[FONT="Arial Narrow"]Sub VeriyeGoreKopya()
Dim Bul As Range
Set Bul = Range("K:K").Find(Range("$D$3"), , , xlWhole)
If Not Bul Is Nothing Then Range(Cells(Bul.Row, "L"), Cells(Bul.Row, "P")).Value = Range("C6:G6").Value
MsgBox "İşleminiz tamamlanmıştır."
End Sub[/FONT]
 
Ömer BARAN' Alıntı:
Tekrar merhaba.

En iyisi aşağıdaki kodu kullanın.
.
Kod: 
[FONT="Arial Narrow"]Sub VeriyeGoreKopya()
Dim Bul As Range
Set Bul = Range("K:K").Find(Range("$D$3"), , , xlWhole)
If Not Bul Is Nothing Then Range(Cells(Bul.Row, "L"), Cells(Bul.Row, "P")).Value = Range("C6:G6").Value
MsgBox "İşleminiz tamamlanmıştır."
End Sub[/FONT]
Genişletmek için tıkla ...

Merhaba,

Ellerinize sağlık. Teşekkür ederim.
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst