داخل رویداد change شیت دیتا این کد را وارد کنید :
کد:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lCount As Long
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("A1:A3")) Is Nothing Then
For lCount = 1 To Sheets.Count
If Sheets(lCount).Name <> Me.Name Then
Sheets(lCount).Name = Me.Cells(lCount, "A")
End If
Next lCount
End If
End Sub
موفق باشید...
Leave a comment: