複製工作表的代號，並重新命名

我想通過它的代碼名稱將工作表複製和重命名複製表顯示名稱和代號，複製工作表的代號，並重新命名

我拿出這一點，但它只能工作一個時間和那麼它會得到一個錯誤，因爲已經有一個顯示名稱和代號的工作表，是否有一個爲什麼我可以在名稱的末尾添加值+ 1？

Sub TESTONE() 


Dim MySheetName As String 
MySheetName = "Rename Me" 
VBA_Copy_Sheet.Copy After:=ActiveSheet 
ActiveSheet.Name = MySheetName 

ActiveSheet.Tab.ColorIndex = 3 

Dim wks As Worksheet 
Set wks = ActiveSheet 
ThisWorkbook.VBProject.VBComponents(wks.CodeName).Name = "BidSheet" 


End Sub

來源

2016-03-28 luke

不，沒有理由。只需按1遞增並將其追加到字符串中，就可以循環使用任意數量的工作表。 – Tim

複印前爲什麼不檢測紙張名稱？子FnGetSheetsName（）昏暗mainworkBook作爲工作簿集mainworkBook = ActiveWorkbook 對於i = 1至mainworkBook.Sheets.count 「要麼我們可以把所有的名字在陣列中，在這裏我們要打印的所有名稱在片2 mainworkBook.Sheets（「Sheet 2中」）。範圍（「A」＆ⅰ）= mainworkBook.Sheets（ⅰ）請將.Name 下一I 結束子 –

@Tim值+ 1不會工作，因爲它複製一個工作表，然後將1加到第一次工作的結尾，但是當您嘗試再次複製工作表時，它只會將1加到複製的使其與第一個副本名稱相同。 – luke

我希望，它有助於你

Sub TESTONE() 

Dim MySheetName As String 
Dim MyCodeName As String 
Dim wks As Worksheet 

MySheetName = "Rename Me" 
MyCodeName = "BidSheet" 

If VBA_Copy_Sheet = Empty Then 
Set VBA_Copy_Sheet = ActiveSheet 
End If 

VBA_Copy_Sheet.Copy After:=ActiveSheet 

ActiveSheet.Name = GetNewSheetName(MySheetName, 0) 

ActiveSheet.Tab.ColorIndex = 3 
Set wks = ActiveSheet 
MyCodeName = GetNewCodeName(MyCodeName, 0) 

ThisWorkbook.VBProject.VBComponents(wks.CodeName).Name = MyCodeName 

End Sub 

Function GetNewSheetName(ByVal newName As String, ByVal n As Integer) As String 

    Dim ws As Worksheet 
    Dim modifiedName As String 
    modifiedName = newName & n 

    For Each ws In ActiveWorkbook.Worksheets 
     If ws.Name = modifiedName Then 
      n = n + 1 
      modifiedName = GetNewSheetName(newName, n) 
      Exit For 
     End If 
    Next 
    GetNewSheetName = modifiedName 
End Function 

Function GetNewCodeName(ByVal newName As String, ByVal n As Integer) As String 

    Dim ws As Worksheet 
    Dim modifiedName As String 
    modifiedName = newName & n 

    For Each ws In ActiveWorkbook.Worksheets 
     If ws.CodeName = modifiedName Then 
      n = n + 1 
      modifiedName = GetNewCodeName(newName, n) 
      Exit For 
     End If 
    Next 
    GetNewCodeName = modifiedName 
End Function

來源

2016-03-28 22:27:07

你可以存儲在一個區域名稱的計數器，並用它來增加您的工作表，即：

Dim strName As String 
Dim strCnt As String 
Dim MySheetName As String 

strName = "SheetCnt" 

On Error Resume Next 
strCnt = ActiveWorkbook.Names(strName).Value 
On Error GoTo 0 
If Len(strCnt) = 0 Then 
    ActiveWorkbook.Names.Add strName, 1 
Else 
    strCnt = Replace(strCnt, "=", Chr(32)) + 1 
    ActiveWorkbook.Names(strName).RefersTo = strCnt 
End If 

MySheetName = "Rename Me " & strCnt

來源

2016-03-30 02:23:51 brettdj

複製工作表的代號，並重新命名

回答

相關問題