السلام عليكم
طاب يومكم
لدي كودان يعملان بشكل ممتاز إذا كان كل كود لوحده في الورقة ولكن عند وضع الإثنين في نفس الورقة أو دمجهم تأتي رسائل خطأ
فأردت أن أدمج كودين بنفس الحدث Worksheet_Change في نفس الشيت
الكود الأول يكتب تاريخ وقت التغيير في خلايا العمود w عندما يحدث هذا التغيير في الخلية المقابلة في العمود h
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("h4:h1000"), Target)
xOffsetColumn = 15
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
الكود الثاني يعمل على فرز التاريخ تصاعدي على حسب التاريخ في خلايا العمود h
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Set Rng = Application.Intersect(Range("H3:H1000"), Range(Target.Address))
If Not Rng Is Nothing Then
If Target.Column = 8 Then
ActiveSheet.Unprotect officena
Rng.Sort Key1:=Range("H4"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1
End If
ActiveSheet.Protect officena, AllowSorting:=True, AllowFiltering:=True
End If
End Sub
ولكم جزيل الشكر
my.xlsm