Please help with Macro delaring variables

Try, repeat, TRY, this one.

Sub AddPO()
Dim Lastsheetname As Variant
Dim WS As Worksheet
Application.ScreenUpdating = False

Lastsheetname = Sheets(Sheets.Count).Name

Set WS = Sheets(Sheets.Count).Copy(After:=Sheets(Sheets.Count))
With WS
.Name = Lastsheetname + 1
.Range("D8") = .Name
With .Range("A44:F70")
.ClearContents
.Interior.ColorIndex = 2
End With
.Range("D10") = Date
.Range("D11").FormulaR1C1 = "=R[-1]C+1"
.Range("D11") = .Range("D11")
.Range("C45").Select
End With
Application.ScreenUpdating = True
End Sub

Juan Pablo G.

Run these 2 ti see the diff.
1st one is your code slight adj
2nd one is an amended version
Basically diff is it doesn't select the
ranges...cuts down unnecessary coding using
with statement........plus uses VBA Date functions
instead of the application worksheet functions >
cuts down on extra processing eg copy | paste etc

HTH

Ivan

Approx diff in time 100% faster

Option Explicit
Dim start

Sub AddPO()
Dim Lastsheetname As Variant
start = Timer
Application.ScreenUpdating = False

Lastsheetname = Sheets(Sheets.Count).Name
Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Lastsheetname & 1
Sheets(Sheets.Count).Range("D8") = Sheets(Sheets.Count).Name
Sheets(Sheets.Count).Range("A44:F70").Select
Selection.ClearContents
With Selection.Interior
.ColorIndex = 2
End With
Sheets(Sheets.Count).Range("D10").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Sheets(Sheets.Count).Range("D11").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+1"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Sheets(Sheets.Count).Range("C45").Select
Application.ScreenUpdating = True
[a1] = Timer - start
End Sub

Sub AddPO_Amd()
Dim Lastsheetname As Variant
start = Timer
Application.ScreenUpdating = False

Lastsheetname = Sheets(Sheets.Count).Name
Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Lastsheetname & 1
.Range("D8") = Sheets(Sheets.Count).Name
.Range("A44:F70").ClearContents
.Range("A44:F70").Interior.ColorIndex = 2
.Range("D10") = Date
.Range("D11") = Date + 1
.Range("C45").Select
End With

Application.ScreenUpdating = True

[a1] = Timer - start

End Sub