Snasui Excel Forum

Code: Select all

Sub Addsheets()
    Dim ws As Worksheet
    Dim worksh As Integer
    Dim worksheetexists As Boolean
    Dim s As String

    s = ActiveSheet.Cells(3, 4).Value
    worksh = Application.Sheets.Count
    worksheetexists = False

    For x = 1 To worksh

        If Worksheets(x).Name = s Then
            worksheetexists = True
            MsgBox s & ", already Exists"
            Exit For
        End If

    Next x
    If worksheetexists = False Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
                .Name = s
                Sheets("Interface").Activate
      ActiveSheet.Range("D2:F3").Select
      Selection.copy
      Application.Goto Reference:=Worksheets(s).Range("A1")
      Selection.PasteSpecial Paste:=xlPasteValues, Paste:=xlPasteformat
      Selection.NumberFormat = "m/d/yyyy""  ""h\:mm\:ss AM/PM"
      Columns("A:A").ColumnWidth = 26
    End If
End Sub