Change sheet name based on cell value

sujittalukde

Well-known Member
Joined
Jun 2, 2007
Messages
520
THis code adds a sheet based on the value of A1
Code:
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

Code:
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
 

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Dylan

Board Regular
Joined
Jul 27, 2007
Messages
150
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

Well-known Member
Joined
Jun 2, 2007
Messages
520
Thanks for the reply,Dylan. One more help required:

for this code line
Code:
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

Board Regular
Joined
Jul 27, 2007
Messages
150
Hi sujittalukde,

Please try change your code to this code.
Code:
ActiveCell.Value = ns
 

Watch MrExcel Video

Forum statistics

Threads
1,122,961
Messages
5,599,061
Members
414,281
Latest member
Engjamal2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top