Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 29-12-2017, 07:17   #1
DMR 7
 
Giriş: 14/09/2017
Şehir: Ankara
Mesaj: 103
Excel Vers. ve Dili:
2010 / Tr
Question A1 hücresinin kopyalanıp veri girilen hücreye yapıştırılması

A1 Hücresinde bir değer var (rakam) ve bu hücre boyalı.


A1 haricinde A sütununda herhangi bir yere ne yazılırsa yazılsın.

A1 hücresinin kopyalanıp veri girilen bu hücreye yapıştırılmasını istiyorum.

Böyle bir şey mümkün mü ?
DMR 7 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 29-12-2017, 10:03   #2
Murat OSMA
Altın Üye
 
Murat OSMA kullanıcısının avatarı
 
Giriş: 23/05/2011
Şehir: İstanbul
Mesaj: 4,950
Excel Vers. ve Dili:
Excel 2016 - Türkçe
Varsayılan

Bu kodları sayfanın kod penceresine yapıştırarak kullanabilirsiniz..

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Row > 1 Then
        Application.EnableEvents = False
        Range("A1").Copy Target
        Application.EnableEvents = True
    End If
End Sub
__________________
Excel'e dair her şey; excelarsivi.com 'da..
Murat OSMA Çevrimdışı   Alıntı Yaparak Cevapla
Eski 29-12-2017, 12:32   #3
Necdet
Moderatör
 
Giriş: 04/06/2005
Şehir: Ankara
Mesaj: 12,186
Excel Vers. ve Dili:
Ofis 2003 İngilizce Ofis 2007 Türkçe Ofis 2010 Türkçe
Varsayılan

Merhaba,

Bu isteği pek mantıklı bulmadım, nerede kullanılabilir ki? Merak ettim doğrusu.

A sütununda bir değişiklik yapıldığında A1 hücresini oraya kopyalamaktansa A sütununda her hangi bir hücreye çift tıklamakla da (A1 hücresi hariç) A1 hücresini kopyalayabilirsiniz.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, [A:A]) And Target.Row = 1 Then Exit Sub
    Target.Value = Range("A1")
    
End Sub
__________________
Sayfada Boş Satırları Silmek:
Sütunu Seçiniz, F5, Özel, Boşluklar, Tamam,
Sağ Klik, Sil, Tüm Satır, Tamam

Türkçe'nin Bir Eksiği Yok, Ya Sizin?



Necdet Çevrimdışı   Alıntı Yaparak Cevapla
Eski 29-12-2017, 13:59   #4
DMR 7
 
Giriş: 14/09/2017
Şehir: Ankara
Mesaj: 103
Excel Vers. ve Dili:
2010 / Tr
Varsayılan

Alıntı:
Necdet Yeşertener tarafından gönderildi Mesajı Görüntüle
Merhaba,

Bu isteği pek mantıklı bulmadım, nerede kullanılabilir ki? Merak ettim doğrusu.

A sütununda bir değişiklik yapıldığında A1 hücresini oraya kopyalamaktansa A sütununda her hangi bir hücreye çift tıklamakla da (A1 hücresi hariç) A1 hücresini kopyalayabilirsiniz.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, [A:A]) And Target.Row = 1 Then Exit Sub
    Target.Value = Range("A1")
    
End Sub
hocam yardımınız için teşekkür ederim ancak mantıklı bulmamak için önce bi sorunu anlamanız gerekirdi. şirkette ürün ağaçlarının kademeleriyle uğraşıyorum. bazen öyle bir durum oluyor ki 50 satırın hepsinin kademesinin birer tane kaydırılıp boyanması diğerlerinin boyalarının ve hücre içeriğinin silinmesi gerekiyor. ben a-b-c-d-e-f----- sütunlarının ilk satırlarına istediğim ağaç seviyesini yerleştirdim. tüm ağacı komple kesip bir sağa yapıştırdığımda otomatik olarak tüm ağaç seviyeleri taşınmış olacak. şirketteki tüm ürünlerin ağaçlarının kalem kalem bu şekilde revizyona uğrayacağını ve defalarca değişiklik yapılacağını varsayar isek, bu basite indirgediğiniz 2 satırlık kod bana saatler kazandıracak.

yine mantıklı bulmazsanız daha detaylı açıklayabilirim.

saygılarımla
DMR 7 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 29-12-2017, 14:00   #5
DMR 7
 
Giriş: 14/09/2017
Şehir: Ankara
Mesaj: 103
Excel Vers. ve Dili:
2010 / Tr
Varsayılan

Alıntı:
Murat OSMA tarafından gönderildi Mesajı Görüntüle
Bu kodları sayfanın kod penceresine yapıştırarak kullanabilirsiniz..

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Row > 1 Then
        Application.EnableEvents = False
        Range("A1").Copy Target
        Application.EnableEvents = True
    End If
End Sub
teşekkür ederim deneyeceğim
DMR 7 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 29-12-2017, 14:12   #6
DMR 7
 
Giriş: 14/09/2017
Şehir: Ankara
Mesaj: 103
Excel Vers. ve Dili:
2010 / Tr
Varsayılan

Alıntı:
Murat OSMA tarafından gönderildi Mesajı Görüntüle
Bu kodları sayfanın kod penceresine yapıştırarak kullanabilirsiniz..

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Row > 1 Then
        Application.EnableEvents = False
        Range("A1").Copy Target
        Application.EnableEvents = True
    End If
End Sub
denedim hocam. işe yarıyor ancak bi sıkıntı oldu. ben oraya herhangi bir veri girersem a1 hücresinin copy paste olmasını istiyorum. o hücreden aynı zamanda veri silip hücrenin boyasını kaldırabilmem de gerekiyor. hücrede hiçbir şey yapmadan enter'a basmak bile orayı direk kopyalıyor. geri nasıl silebilirim ?
DMR 7 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 29-12-2017, 14:12   #7
DMR 7
 
Giriş: 14/09/2017
Şehir: Ankara
Mesaj: 103
Excel Vers. ve Dili:
2010 / Tr
Varsayılan

Alıntı:
Necdet Yeşertener tarafından gönderildi Mesajı Görüntüle
Merhaba,

Bu isteği pek mantıklı bulmadım, nerede kullanılabilir ki? Merak ettim doğrusu.

A sütununda bir değişiklik yapıldığında A1 hücresini oraya kopyalamaktansa A sütununda her hangi bir hücreye çift tıklamakla da (A1 hücresi hariç) A1 hücresini kopyalayabilirsiniz.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, [A:A]) And Target.Row = 1 Then Exit Sub
    Target.Value = Range("A1")
    
End Sub
sizin kodlarınızı çalıştıramadım
DMR 7 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 29-12-2017, 14:19   #8
DMR 7
 
Giriş: 14/09/2017
Şehir: Ankara
Mesaj: 103
Excel Vers. ve Dili:
2010 / Tr
Varsayılan

http://s7.dosya.tc/server/6c0yim/Deneme.zip.html



anlatmak istediğim şu idi. soldaki bloğu olduğu gibi bir sütun sağa kaydırdım. hepsinin numarası birer artıp, renkleri ilk satırdaki gibi olmalı. istediğim zaman silmem gerekiyor.

Bu mesaj en son " 02-01-2018 " tarihinde saat 11:30 itibariyle DMR 7 tarafından düzenlenmiştir....
DMR 7 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 29-12-2017, 21:57   #9
PLİNT
 
Giriş: 30/12/2014
Şehir: Gürün
Mesaj: 1,413
Excel Vers. ve Dili:
Excel 2010
Varsayılan

Merhaba
Ek dosyadaki gibi denermisiniz?
http://s7.dosya.tc/server/o9s9zr/Deneme.zip.html
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Cells.Count <> 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Intersect(Target, [B:I]) Is Nothing Then Exit Sub
Application.EnableEvents = False
If WorksheetFunction.CountIf(Range("B" & Target.Row & ":I" & Target.Row), "") < 7 Then
MsgBox "Bu satırda zaten veri var"
Target.Value = ""
Application.EnableEvents = True
Exit Sub
End If
Range("B" & Target.Row & ":I" & Target.Row).Clear
Cells(1, Target.Column).Copy Target
Application.EnableEvents = True
End Sub

Bu mesaj en son " 02-01-2018 " tarihinde saat 12:01 itibariyle PLİNT tarafından düzenlenmiştir....
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-01-2018, 07:32   #10
DMR 7
 
Giriş: 14/09/2017
Şehir: Ankara
Mesaj: 103
Excel Vers. ve Dili:
2010 / Tr
Varsayılan

Alıntı:
PLİNT tarafından gönderildi Mesajı Görüntüle
Merhaba
Ek dosyadaki gibi denermisiniz?
http://s7.dosya.tc/server/o9s9zr/Deneme.zip.html
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Cells.Count <> 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Intersect(Target, [B:I]) Is Nothing Then Exit Sub
Application.EnableEvents = False
If WorksheetFunction.CountIf(Range("B" & Target.Row & ":I" & Target.Row), "") < 7 Then
MsgBox "Bu satırda zaten veri var"
Target.Value = ""
Application.EnableEvents = True
Exit Sub
End If
Range("B" & Target.Row & ":I" & Target.Row).ClearFormats
Cells(1, Target.Column).Copy Target
Application.EnableEvents = True
End Sub
Sayın Plint, gerçekten çok teşekkür ederim. o satıra yeni bir veri girildiğinde istediğim işlemi yapıyor.

2 küçük şey daha istesem bununla ilgili;

İlki: Örnek exceldeki tüm satırları kesip 2 sağa veya 1 sola yapıştırsak ve yapıştırdığımız sütunların baş hücrelerine dönüşseler olur mu ?

kesip veya kopyalayıp yapıştırdığımızda olmuyor.

İkincisi: Herhangi bir satırda bir rakam girildiğinde o hücre hariç kalan 7 hücrenin çerçeveleri siliniyor.

Bu ikisi düzeltilebilir mi?
DMR 7 Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 19:57


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Dil Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Rampa- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Şişli Avukat- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kağıt Bardak- Çorlu Havuz- Çorlu Havuz- Çorlu Perde Yıkama- Okul Danışmanlık- ADR'li taşıma kabı imalatı- Mekanik Tesisat- Çorlu Grafik Tasarım- Çorlu Sondaj- Çorlu Etüt- Futbol Cafe- Beylikdüzü Temizlik- Çorlu Kurs- Çorlu Ders- İzmit Mimar- Hurda Bakır Kablo- Hurda Bakır Kablo- Çorlu Pronet- Çorlu Yönetim- Çorlu Apartman Yönetimi- Çorlu Marangoz- Çorlu Avukat-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden