G
Gunnar Johansson
Hi,
In case of change of cells within two areas, I want to restore the format in
the areas from the format source cell "C1" AND also replicate the cell
values from sheet1 to sheet2. It doesn't work. I'm grateful to any help!
Thanks in advance.
/Gunnar
Private Sub Worksheet_Change(ByVal Target As Range)
'**************************************
On Error GoTo errorhandler1
Application.ScreenUpdating = False
Application.EnableEvents = False
sheet1.Unprotect
'Restore format
'Replicate values to other sheet
If Not Application.Intersect(Target, Range("A1:B2"), Range("A4:B5")) Is
Nothing Then
sheet1.Range("C1").Copy
sheet1.Range("A1:B2").PasteSpecial (xlPasteFormats)
sheet1.Range("A4:B5").PasteSpecial (xlPasteFormats)
sheet2.Unprotect
sheet2.Range("A1:B2").Value = sheet1.Range("A1:B2").Value
sheet2.Range("A4:B5").Value = sheet1.Range("A4:B5").Value
End If
' Normal end of Sub
Application.ScreenUpdating = True
Application.EnableEvents = True
sheet1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
sheet1.EnableSelection = xlUnlockedCells
Exit Sub
'Error handler - protect & end sub when error occure
errorhandler1: MsgBox prompt:="Unexpected error (errorcode " &
Str$(Err.Number) & ") in Sub Worksheet_Change " & vbCrLf _
& "Description: " & Err.Description, _
Buttons:=vbCritical + vbMsgBoxHelpButton, _
Title:="Error!", _
HelpFile:=Err.HelpFile, _
Context:=Err.HelpContext
Application.ScreenUpdating = True
Application.EnableEvents = True
Blad1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Blad1.EnableSelection = xlUnlockedCells
Exit Sub
End Sub
In case of change of cells within two areas, I want to restore the format in
the areas from the format source cell "C1" AND also replicate the cell
values from sheet1 to sheet2. It doesn't work. I'm grateful to any help!
Thanks in advance.
/Gunnar
Private Sub Worksheet_Change(ByVal Target As Range)
'**************************************
On Error GoTo errorhandler1
Application.ScreenUpdating = False
Application.EnableEvents = False
sheet1.Unprotect
'Restore format
'Replicate values to other sheet
If Not Application.Intersect(Target, Range("A1:B2"), Range("A4:B5")) Is
Nothing Then
sheet1.Range("C1").Copy
sheet1.Range("A1:B2").PasteSpecial (xlPasteFormats)
sheet1.Range("A4:B5").PasteSpecial (xlPasteFormats)
sheet2.Unprotect
sheet2.Range("A1:B2").Value = sheet1.Range("A1:B2").Value
sheet2.Range("A4:B5").Value = sheet1.Range("A4:B5").Value
End If
' Normal end of Sub
Application.ScreenUpdating = True
Application.EnableEvents = True
sheet1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
sheet1.EnableSelection = xlUnlockedCells
Exit Sub
'Error handler - protect & end sub when error occure
errorhandler1: MsgBox prompt:="Unexpected error (errorcode " &
Str$(Err.Number) & ") in Sub Worksheet_Change " & vbCrLf _
& "Description: " & Err.Description, _
Buttons:=vbCritical + vbMsgBoxHelpButton, _
Title:="Error!", _
HelpFile:=Err.HelpFile, _
Context:=Err.HelpContext
Application.ScreenUpdating = True
Application.EnableEvents = True
Blad1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Blad1.EnableSelection = xlUnlockedCells
Exit Sub
End Sub