Snasui Excel Forum

Code: Select all

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim s As Worksheet
    Dim ns As Worksheet
    Dim sr As Range
    
    Application.EnableEvents = False
    With Me
        If Target.Column = 3 And Target.Row > 1 Then
            On Error Resume Next
            Set s = ThisWorkbook.Worksheets(Target.Value)
            If s Is Nothing Then
                On Error GoTo 0
                Set sr = Target.Resize(10)
                sr.FillDown
                Set ns = ThisWorkbook.Worksheets.Add(after:= _
                    ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
                With ns
                    .Name = Target.Value
                    .Range("a1:b1").Value = Array("Code", "Job")
                    .Range("a1:b1").Borders.LineStyle = xlContinuous
                    sr.Offset(0, -1).Resize(, 2).Copy .Range("a2")
                    .Range("a1:b1").EntireColumn.AutoFit
                End With
            Else
                Target.Value = ""
                MsgBox "This sheet name is already exist"
                
            End If
        End If
    End With
    Application.EnableEvents = True
End Sub