Aktar

[polis-53]

Merhaba arkadaşlar ekte gönderdiğim dosyada E sutununda yazdığım rakamları D sutununa aktarmak istiyorum formul kullanılmayacak.

 

[Mahir64]

Merhaba arkadaşlar ekte gönderdiğim dosyada E sutununda yazdığım rakamları D sutununa aktarmak istiyorum formul kullanılmayacak.

Merhaba,

Kopyala / Yapıştır yapın.

 

[İhsan Tank]

Merhaba arkadaşlar ekte gönderdiğim dosyada E sutununda yazdığım rakamları D sutununa aktarmak istiyorum formul kullanılmayacak.

Merhaba
Sayfanın kod bölümüne kopyalayın ve giriş yaparak deneyin.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E2:E65536")) Is Nothing Then Exit Sub
Cells(Target.Row, "D") = Target
End Sub

 

[polis-53]

merhaba İhsan tanık bey D sutunundaki rakamlar sabit kalacak E sutununa Her Yazdığım Rakamları D sutunundaki Rakamların üzerine ekleyecek

 

[Bogachank]

İhsan beyin çalışmasına alternatif olarak;

modüle kopyalayıp çalıştırın.

Sub kopyala()
    Dim rSource As Excel.Range
    Dim rDestination As Excel.Range
    Set rSource = ActiveSheet.Range("[COLOR=Red]e:e[/COLOR]")
    Set rDestination = ActiveSheet.Range("[COLOR=Red]d:d[/COLOR]")
     
    rSource.Copy
    rDestination.Select
     
    Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, _
    SkipBlanks:=False, _
    Transpose:=False
     
    Range("A1").Select
     
    Application.CutCopyMode = False
     
valKill:
    Set rSource = Nothing
    Set rDestination = Nothing
     
    Exit Sub
     
End Sub

 

[Bogachank]

merhaba İhsan tanık bey D sutunundaki rakamlar sabit kalacak E sutununa Her Yazdığım Rakamları D sutunundaki Rakamların üzerine ekleyecek

    Sub kopyala()
    Dim rSource As Excel.Range
    Dim rDestination As Excel.Range
    Set rSource = ActiveSheet.Range("e:e")
    Set rDestination = ActiveSheet.Range("d:d")
     
    rSource.Copy
    rDestination.Select
     
    Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlAdd, _
    SkipBlanks:=False, _
    Transpose:=False
     
    Range("A1").Select
     
    Application.CutCopyMode = False
     
valKill:
    Set rSource = Nothing
    Set rDestination = Nothing
     
    Exit Sub
     
End Sub

sanırsam bu işinizi görücektir.

 

[İhsan Tank]

merhaba İhsan tanık bey D sutunundaki rakamlar sabit kalacak E sutununa Her Yazdığım Rakamları D sutunundaki Rakamların üzerine ekleyecek

Bunu baştan söyleseydiniz ona göre çözüm üretirdim

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E2:E65536")) Is Nothing Then Exit Sub
Cells(Target.Row, "D") = Cells(Target.Row, "D") + Target
End Sub

Bunu deneyin.

 

[polis-53]

çooooooook teşekkür ederim İhsan bey elleriniz dert görmesin kalın sağlıcakla
ALLAH butun işlerinde kolaylıklar versin
iyigünler

 

[İhsan Tank]

çooooooook teşekkür ederim İhsan bey elleriniz dert görmesin kalın sağlıcakla
ALLAH butun işlerinde kolaylıklar versin
iyigünler

Rica ederim
Amin
:keyif: