- Katılım
- 29 Kasım 2007
- Mesajlar
- 1,110
- Excel Vers. ve Dili
- excel 2007
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("Z3:Z65536")) Is Nothing Then Exit Sub
If IsDate(Target) Then
Cells(Target.Row, "A").Copy Cells(Target.Row, "X")
Cells(Target.Row, "B").Copy Cells(Target.Row, "Y")
Cells(Target.Row, "A").ClearContents
Cells(Target.Row, "B").ClearContents
End If
End Sub
Selamlar,
Sayfanızın kod bölümüne aşağıdaki kodu uygulayarak silme ve aktarma işlemini yapabilirsiniz.
Kod:Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("Z3:Z65536")) Is Nothing Then Exit Sub If IsDate(Target) Then Cells(Target.Row, "A").Copy Cells(Target.Row, "X") Cells(Target.Row, "B").Copy Cells(Target.Row, "Y") Cells(Target.Row, "A").ClearContents Cells(Target.Row, "B").ClearContents End If End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("Z3:Z65536")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo Son
Application.EnableEvents = False
If Target = "" Then
Cells(Target.Row, "A").ClearContents
Cells(Target.Row, "B").ClearContents
End If
Son: Application.EnableEvents = True
End Sub