Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Makro-VBA (http://www.excel.web.tr/forumdisplay.php?f=48)
-   -   A1 hücresinin kopyalanıp veri girilen hücreye yapıştırılması (http://www.excel.web.tr/showthread.php?t=169347)

DMR 7 29-12-2017 08:17

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ü ?

Murat OSMA 29-12-2017 11:03

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

Kod:

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


Necdet Yeşertener 29-12-2017 13:32

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:

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


DMR 7 29-12-2017 14:59

Alıntı:

Necdet Yeşertener tarafından gönderildi (Mesaj 923768)
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:

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 29-12-2017 15:00

Alıntı:

Murat OSMA tarafından gönderildi (Mesaj 923748)
Bu kodları sayfanın kod penceresine yapıştırarak kullanabilirsiniz..

Kod:

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 29-12-2017 15:12

Alıntı:

Murat OSMA tarafından gönderildi (Mesaj 923748)
Bu kodları sayfanın kod penceresine yapıştırarak kullanabilirsiniz..

Kod:

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 29-12-2017 15:12

Alıntı:

Necdet Yeşertener tarafından gönderildi (Mesaj 923768)
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:

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 29-12-2017 15:19

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

https://i.hizliresim.com/g97370.png

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.

PLİNT 29-12-2017 22:57

Merhaba
Ek dosyadaki gibi denermisiniz?
http://s7.dosya.tc/server/o9s9zr/Deneme.zip.html
Kod:

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


DMR 7 02-01-2018 08:32

Alıntı:

PLİNT tarafından gönderildi (Mesaj 923844)
Merhaba
Ek dosyadaki gibi denermisiniz?
http://s7.dosya.tc/server/o9s9zr/Deneme.zip.html
Kod:

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?


Saat 13:03

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.