Change sheet name based on cell value

[sujittalukde]

THis code adds a sheet based on the value of A1

Sub AddSheet()
Dim ws As Worksheet
Dim newSheetName As String
newSheetName = Sheets(1).Range("A1")   '   Substitute your range here
    For Each ws In Worksheets
        If ws.Name = newSheetName Or newSheetName = "" Or IsNumeric(newSheetName) Then
            MsgBox "Sheet already exists or name is invalid", vbInformation
            Exit Sub
        End If
    Next
Sheets.Add Type:="Worksheet"
    With ActiveSheet
        .Move After:=Worksheets(Worksheets.Count)
        .Name = newSheetName
    End With
End Sub

This code copy data data from "Import" sheet and paste to "PTC" sheet

Sub SaveData()

    Sheets("Import").Select
    Range("A2:F143").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-153
    Sheets("PTC").Select
    Range("A2").Select
    ActiveSheet.Paste
    Selection.Columns.AutoFit
    Selection.Rows.AutoFit
    Rows("9:9").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=18
    Rows("34:48").Select
    Selection.Delete Shift:=xlUp
    Rows("35:35").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=24
    Rows("60:60").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=9
    Rows("65:76").Select
    Selection.Delete Shift:=xlUp
    Rows("66:66").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=-81
    Cells.Select
    Selection.Rows.AutoFit
    Selection.Columns.AutoFit
    Range("A2").Select
    Rows("1:1").RowHeight = 24
    Range("B1:F1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Name of The Company"
    Range("B1:F1").Select
    Sheets("PTC").Select
    ActiveCell.FormulaR1C1 = "PTC"
    Range("B1:F1").Select
    Selection.Font.Bold = True
    Range("A1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B1:F1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection.Interior
        .ColorIndex = 3
        .Pattern = xlSolid
    End With
    Selection.Font.ColorIndex = 2
    Range("A1").Select
    With Selection.Interior
        .ColorIndex = 37
        .Pattern = xlSolid
    End With
    Selection.Font.Bold = True
    Range("A1").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Items"
    Range("A9").Select
    ActiveCell.FormulaR1C1 = "Items"
    Range("A10").Select
    ActiveWindow.SmallScroll Down:=-24
    Sheets("Import").Select
    ActiveWindow.SmallScroll Down:=-12
    Range("A1").Select
    ActiveWorkbook.Save
End Sub

The problem with second code is that the sheet name is fixed as PTC. This is a recorded macro.

Can the second code be modified in such a manner that it Sheet PTC will become variable one and instead of PTC, the value at A1 of Import sheet will come in place of PTC. ie if the value at A1 is ABC then the code should change to Sheets("ABC").Select instead of Sheets("PTC").Select

 

[Dylan]

Below code should work. Replace all "PTC" with ns

Sub SaveData()
ns = sheets("Import").range("A1").value
Sheets("Import").Select
Range("A2:F143").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-153
Sheets(ns).Select

 

[sujittalukde]

Thanks for the reply,Dylan. One more help required:

for this code line

ActiveCell.FormulaR1C1 = "PTC"

THis code is used to Put the sheet name in cell B1 of newly added sheet. I recorded it by selecting the sheet name , copied and pasted the sheet name at cell B1 of newly added "PTC". Now when I modified the code with your code, everything running well but newly added sheet still put "PTC" at cell B1.

I tried the modified code for "ABC", it is adding a sheet named ABC and also copying data but naming the cell b1 as PTC instead of ABC.

Can you suggest some modification for the same also?

 

[Dylan]

Hi sujittalukde,

Please try change your code to this code.

ActiveCell.Value = ns

 

[sujittalukde]

Thanks for the reply and effort. Its working