- Katılım
- 1 Ağustos 2011
- Mesajlar
- 107
- Excel Vers. ve Dili
- excel 2010
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)
Dim SYF As Worksheet, STR As Long
Application.EnableEvents = False
If Intersect(Target, Range("G:G")) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
Application.ScreenUpdating = False
Set SYF = Sheets("İŞTEN AYRILANLAR")
STR = SYF.Range("A" & Rows.Count).End(xlUp).Row + 1
If Target <> Empty Then
Range("A" & Target.Row & ":H" & Target.Row).Copy Destination:= _
SYF.Range("A" & STR)
Rows(Target.Row).Delete
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
öncelikle teşekkür ederim bu kodu ekledim ama sanırıkm beceremedim siz makrosunu düzenleyip tekrar atarmısınız.
efendim çok teşekkür ediyorum..
asi kral 1967 pardon size bir şey sormak istiyorum şimdi bunu kendi dosyamda uyguladım ama gene beceredim yardımcı olursanız çok sevineceğim....
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SYF As Worksheet, STR As Long
Application.EnableEvents = False
If Intersect(Target, Range("G:G")) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
Application.ScreenUpdating = False
Set SYF = Sheets("İŞTEN ÇIKIŞ")
STR = SYF.Range("A" & Rows.Count).End(xlUp).Row + 1
If Target <> Empty Then
Range("A" & Target.Row & ":D" & Target.Row).Copy Destination:= _
SYF.Range("A" & STR)
Range("G" & Target.Row).Copy Destination:= _
SYF.Range("E" & STR)
Range("E" & Target.Row).Copy Destination:= _
SYF.Range("F" & STR)
Rows(Target.Row).Delete
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
valla çok olduğumu biliyorum ama gene makroyu yapıpta bana excel dosyası olarak gönderirmisiniz.
ilginize teşekkür ediyorum aynısını bende yaptım ben makro üzerinden çalıştır diyince bende hata veriyor.ama excelde normal çalışıyormuş.sizinkide de aynı çıkıyor (makro kayıt ekranı geliyor) bende hatalı sanıyordum.çok teşekkürler.