无法重新命名工作表中的工作表

我正在做一个简单的脚本，从不同的工作簿中拿出一堆床单放在一本工作簿上。 我必须重新命名所有表单，以便与其他脚本一起工作。 所有的表格都重新命名，除了我从eod循环中获得的表格外， 前两张被重新命名，但之后没有一个在循环中。 所有的工作薄都来自xlsx格式，其余的都是xls格式。 我把放在xls中的每张表格在macros完成时都会closures，但所有的xlsx格式文件都不会。 我不知道这是否是问题的一部分。 什么会导致这只重命名某些表？

Sub getSheets() num = 1 -----> ' loop for eod Do Until copyover("Weekly", "EOD Week " & num) = False num = num + 1 Loop temp = copyover("Voice_of_the_Customer", "VOC") temp = copyover("Daily_Cp%_v2", "COMP") temp = copyover("MPJ-Scorecard-QC-Summary", "QC") temp = copyover("MPJ-Scorecard-SCOI-Summary", "SCOI") temp = copyover("TechUpstreamTransmit", "UPSQ") temp = copyover("Daily_CCG_OTG", "MTF") temp = copyover("summary", "S7 QC") temp = copyover("MPJ-Scorecard-TCF-Summary", "TCF") End Sub Function copyover(SheetAd As String, SheetName As String) As Boolean Dim origWork As Workbook Dim fileName As String Dim copytoFile As Variant Dim copytoFile2 As Workbook Set origWork = ActiveWorkbook tem = MsgBox("Do you want to add " & SheetName, vbYesNoCancel) If (tem = vbYes) Then copyover = True On Error GoTo ErrHandler copytoFile = Application.GetOpenFilename _ (Title:=SheetAd, _ FileFilter:="Excel Files *.x* (*.x*),") Workbooks.Open copytoFile Set copytoFile2 = ActiveWorkbook copytoFile2.Sheets(SheetAd).Move After:=origWork.Sheets("TechScore") 'ActiveSheet.Name = SheetName origWork.Activate origWork.Sheets(SheetAd).Name = SheetName 'ThisWorkbook.VBProject.VBComponents(SheetAd).Name = "Mudface" Workbooks(copytoFile).Close False Else If (tem = vbNo) Then copyover = False End If End If ErrHandler: End Function 

Answer 1

这是我很难跟随的。 看起来你的生活相当危险，如何编码。 origWork从不初始化。 如果你在你的模块/表单代码中的所有代码之上加上“明确的选项”，它可能会对你有所帮助。 我认为你的工作的一部分基本上是在某个地方迷失在记忆中，永远不会结束在你认为的地方。 尝试在某些关键线上添加断点并检查正在引用的工作簿。 对于VBA来说，这是非常非常好的事情，因为您可以在运行时debugging/编辑variables。

Answer 2

如果你只想重命名具有特定名称的特定表单，我已经做了一些macros来快速完成这个工作：

macros1

 Sub Sheetlist() Dim x As Integer Sheets.Add After:=ActiveSheet ActiveSheet.Name = "sheetlist" Range("A1").Select ActiveCell.FormulaR1C1 = "Sheet List" Range("C1").Select ActiveCell.FormulaR1C1 = "New List" For x = 1 To Worksheets.Count Cells(x + 1, 1).Value = Worksheets(x).Name Next x End Sub 

这会在工作簿中创build一个名为sheetlist的工作表，将列出当前工作簿中的所有工作表。 您可以消除任何您不想用下一个macros重命名的图纸名称，但要确保没有空白。

有一个标题为“新列表”的列（C），您可以放置​​要调用表的名称列表。 确保此表与A列具有相同的名称数量

macros2：

 Sub batchrename() ' ' batchrename Macro ' Dim OldSheetName As String Dim NewSheetName As String Dim SheetCount As Integer Dim NewSheetList As String NewSheetList = InputBox("How many names are there?") + 1 For SheetCount = 1 To Range("C2:C" & NewSheetList).Count OldSheetName = Sheets("sheetlist").Cells(SheetCount + 1, 1) NewSheetName = Sheets("sheetlist").Cells(SheetCount + 1, 3) Sheets(OldSheetName).Select ActiveSheet.Name = NewSheetName Next SheetCount End Sub 

这将把A的表格重新命名为C中的名字。提示会询问你名字列表的位置，input新名称列表的全部范围（例如：C2：C250），然后回车。

希望这可以帮助，