Sub CopySheetRename()
Dim Cpt As Byte

For Cpt = 17 To 27
  With ActiveWorkbook.ActiveSheet
    .Copy After:=Worksheets(Worksheets.Count)
  End With
ActiveSheet.Name = "Sem" & Cpt
Next Cpt

End Sub