toandiennuoc123
Thành viên thường trực




- Tham gia
- 7/3/12
- Bài viết
- 239
- Được thích
- 9
Nhờ các Pro xem code này viết và chèn có đúng không?
Code 1 : Cộng dồn và tự động xoá
Code 2 : Vùng H4:Q13 ở Sheet 1 sẽ tự động được link sang các Sheet 2 đến Sheet 9 cũng ở tại vùng H4:Q13.
Xin chân thành cám ơn!
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Tem As Variant
If Not Intersect(Target, [AF4:AO13]) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(29) = Target.Offset(29) + Tem
Target.ClearContents
Application.EnableEvents = True
ElseIf Not Intersect(Target, [AF20:AO29]) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(13, -12) = Target.Offset(13, -12) + Tem
Target.ClearContents
Application.EnableEvents = True
ElseIf Not Intersect(Range("AR20:AR29,AU20:AU29,AX20:AX29,BA19:BA30,BD19:BD30,BG16:BG30,BJ19:BJ22"), Target) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(, 1) = Target.Offset(, 1) + Tem
Target.ClearContents
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S2").Range("H4:Q13").Value = Range("H4:Q13").Value
End If
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S3").Range("H4:Q13").Value = Range("H4:Q13").Value
End If
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S4").Range("H4:Q13").Value = Range("H4:Q13").Value
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S5").Range("H4:Q13").Value = Range("H4:Q13").Value
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S6").Range("H4:Q13").Value = Range("H4:Q13").Value
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S7").Range("H4:Q13").Value = Range("H4:Q13").Value
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S8").Range("H4:Q13").Value = Range("H4:Q13").Value
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S9").Range("H4:Q13").Value = Range("H4:Q13").Value
End Sub
Code 1 : Cộng dồn và tự động xoá
Code 2 : Vùng H4:Q13 ở Sheet 1 sẽ tự động được link sang các Sheet 2 đến Sheet 9 cũng ở tại vùng H4:Q13.
Xin chân thành cám ơn!
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Tem As Variant
If Not Intersect(Target, [AF4:AO13]) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(29) = Target.Offset(29) + Tem
Target.ClearContents
Application.EnableEvents = True
ElseIf Not Intersect(Target, [AF20:AO29]) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(13, -12) = Target.Offset(13, -12) + Tem
Target.ClearContents
Application.EnableEvents = True
ElseIf Not Intersect(Range("AR20:AR29,AU20:AU29,AX20:AX29,BA19:BA30,BD19:BD30,BG16:BG30,BJ19:BJ22"), Target) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(, 1) = Target.Offset(, 1) + Tem
Target.ClearContents
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S2").Range("H4:Q13").Value = Range("H4:Q13").Value
End If
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S3").Range("H4:Q13").Value = Range("H4:Q13").Value
End If
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S4").Range("H4:Q13").Value = Range("H4:Q13").Value
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S5").Range("H4:Q13").Value = Range("H4:Q13").Value
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S6").Range("H4:Q13").Value = Range("H4:Q13").Value
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S7").Range("H4:Q13").Value = Range("H4:Q13").Value
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S8").Range("H4:Q13").Value = Range("H4:Q13").Value
If Not Intersect(Range("H4:Q13"), Target) Is Nothing Then
Sheets("S9").Range("H4:Q13").Value = Range("H4:Q13").Value
End Sub