Soru Sayı Girdiğimde Sayı Bir Sütün Sağa Kaymasını Istiyorum

[fatalmen33]

Lütfen yardımıc olur musnuz ben 5 sayılık bir değer girdiğimde mesela A sütünuna sayı girdiğimde A da ki sayı Bye Bde ki sayı Cye kaysın sitşyorum bu şekilde mümkün mü lütfen yardımcı olur musnuz örnek ekte dir

 

[fatalmen33]

Dosya ekleyemedim

 

[kubilay242]

Görsel ekleyebilir misiniz?

 

[fatalmen33]

tabi hocam

 

[fatalmen33]

tuX03H.png

tuX03H Fotoğrafı, resimleri, fotoğrafları

hizliresim.com

 

[fatalmen33]

@kubilay242 buyur hocam

 

[Necdet]

Merhaba,

Aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [A:A]) Is Nothing Or Target.Row < 2 Then Exit Sub
    
    Application.EnableEvents = False
    
    Target.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    Application.EnableEvents = True
    
End Sub

 

[fatalmen33]

@Necdet Hocam harikasın ama ufak bir sorun var 5 sayıdan sonra ki sayı silebilir miyiz yoksa sayı uzun uzun uzayacak

 

[fatalmen33]

@Necdet hocam bir de sağa kayan sayıyı eşittir ile çektiğim zaman ona formül uygulayamayıyırum yanş sayı kendilini yenilrmiyor

 

[Necdet]

Merhaba,

Kodları yazdığımda eklediğiniz resmi görmemiştim.
Yukarıda verdiğim kodlar sizin isteğinize göre yanlış oluyordu. Ben A sütununu silerek sağ tarafa aktarmıştım, oysa siz önceki bilgilerin aktarılmasını istiyorsunuz.
Kodları buna göre revize ettim ama son açıklamanızı anlamadım.

Eğer Dosya.co gibi paylaşım sitelerinden birine örnek dosyanızı yüklerseniz ilgilenecek arkadaşlar çıkacaktır.

Public Deg  As Variant

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [A:A]) Is Nothing Or Target.Row < 2 Or Target.Value = "" Then Exit Sub
    Application.EnableEvents = False
    Target.Offset(0, 1).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Target.Offset(0, 1) = Deg
    Target.Offset(0, 5) = ""
    Application.EnableEvents = True
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Intersect(Target, [A:A]) Is Nothing Or Target.Row < 2 Then Exit Sub
    Deg = Target.Value
    
End Sub

 

[fatalmen33]

@Necdet Hocam gerçekten süpersiniz şimdi tek sorun sayfa 1 sayı girdiğimde kayıyor evet ama bu sefer o sayıları eşittir ile çekince gelmiyor ona çözüm olur mu size attım dosyayı

İndir Yeni Microsoft Excel Çalışma Sayfası

Dosyayı indir Yeni Microsoft Excel Çalışma Sayfası

dosya.co

 

[fatalmen33]

@Necdet Hocam gerçekten süpersiniz şimdi tek sorun sayfa 1 sayı girdiğimde kayıyor evet ama bu sefer o sayıları eşittir ile çekince gelmiyor ona çözüm olur mu size attım dosyayı

İndir Yeni Microsoft Excel Çalışma Sayfası

Dosyayı indir Yeni Microsoft Excel Çalışma Sayfası

dosya.co

Hocam bundan başka bir sorun kalmadı süper olmuş

 

[Korhan Ayhan]

Alternatif;

EŞİTTİR ile yapmak istediğinizi bende anlayamadım.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Application.EnableEvents = False
        Target.Offset(, 1).Resize(1, 4).Value = Target.Resize(1, 4).Value
        Application.EnableEvents = True
    End If
End Sub