篇首语：本文由小编为大家整理，主要介绍了Excel VBA - 组合宏以重命名工作表和宏以在一个宏中合并工作表相关的知识，希望对你有一定的参考价值。

我正在使用两个宏。第一个将excel文件的工作表重命名为工作簿名称的宏。第二个宏将这些重命名的工作簿（仅包含一个工作表）合并到一个工作簿中。每个重命名的工作簿都是由第二个宏创建的新工作簿中的单独选项卡。

其中一个文件的名称示例：AA_aaa ## 123456789-123456789。在重命名宏中，我从名称中删除了最后一个字符，因此工作表名为AA_aaa。所有文件都有不同的名称，但都具有相同的格式和长度。

对于第一个宏，我打开每个excel文件，运行宏并关闭并再次保存excel文件。对于第二个宏，我打开一个只包含合并宏的exmpy excel文件。我从这个文件运行合并宏，它要求我选择我想要合并的文件。我想要合并的文件需要在那时关闭。

我采取的步骤的顺序是：1.我打开要为其重命名工作表的excel文件。2.我运行重命名宏（我有另一个excel打开，包含要重命名的宏，所以我可以从那里选择它）。3.使用重命名的工作表保存并关闭工作簿。4.我对所有其他excel文件都这样做（我通常会在文件10周围重命名一次）。5.我打开一个包含合并宏的Excel文件（excel文件中没有数据）。6.我运行合并宏。7.宏要求我选择要合并的文件（这些是我在前面的步骤中重命名的10个文件）。8.我选择在我的第一步中重命名的文件。

结果：我现在有一个包含多个工作表的文件，这些工作表包含我重命名的文件中的数据，每个工作表的名称是原始文件的名称！

我每天需要做大约20次这个过程。特别是第1步（重命名工作表）需要花费大量时间，因为我需要单独打开并保存每个文件。我希望有人可以帮我把这两个宏组合成一个。目的是运行1个宏，首先重命名工作表，然后将它们合并到一个文件中。

这些是我目前使用的宏：

宏1重命名工作表：

Sub RenameSheet()Dim mynamemyname = Replace(ActiveWorkbook. Name, ".xls", "")    ActiveSheet.Select    Activesheet.Name = Left$(Activeworkbook.Name, InStrRev(Activeworkbook.Name,".")-22)    Range("A1").SelectEnd Sub

宏2合并工作簿：

Sub MergeExcelFiles()    Dim fnameList, fnameCurFile As Variant    Dim countFiles, countSheets As Integer    Dim wksCurSheet As Worksheet    Dim wbkCurBook, wbkSrcBook As Workbook    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)    If (vbBoolean <> VarType(fnameList)) Then        If (UBound(fnameList) > 0) Then            countFiles = 0            countSheets = 0            Application.ScreenUpdating = False            Application.Calculation = xlCalculationManual            Set wbkCurBook = ActiveWorkbook            For Each fnameCurFile In fnameList                countFiles = countFiles + 1                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)                For Each wksCurSheet In wbkSrcBook.Sheets                    countSheets = countSheets + 1                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)                Next                wbkSrcBook.Close SaveChanges:=False            Next            Application.ScreenUpdating = True            Application.Calculation = xlCalculationAutomatic            MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"        End If    Else        MsgBox "No files selected", Title:="Merge Excel files"    End IfEnd Sub

答案

您可以将它们分开，而不是合并宏，只需将它们从一个中调用：

Sub RunMyMacros()RenameSheetMergeExcelFilesEnd Sub

在您的情况下，我认为这将是最干净的解决方案。合并它们不会提高性能。

如果你真的需要它们，我想它看起来像这样 - 请注意，我已经在一些基本无用的行上做了几点评论：

Sub MergeExcelFiles()    Dim fnameList, fnameCurFile As Variant    Dim countFiles, countSheets As Integer    Dim wksCurSheet As Worksheet    Dim wbkCurBook, wbkSrcBook As Workbook    Dim myname    "Rename sheet    myname = Replace(ActiveWorkbook.Name, ".xls", "")    "ActiveSheet.Select     "this serves no purpose    ActiveSheet.Name = Left$(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 22)    Range("A1").Select "I don"t think this does anything for you either    "Merge excel files    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)    If (vbBoolean <> VarType(fnameList)) Then        If (UBound(fnameList) > 0) Then            countFiles = 0            countSheets = 0            Application.ScreenUpdating = False            Application.Calculation = xlCalculationManual            Set wbkCurBook = ActiveWorkbook            For Each fnameCurFile In fnameList                countFiles = countFiles + 1                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)                For Each wksCurSheet In wbkSrcBook.Sheets                    countSheets = countSheets + 1                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)                Next                wbkSrcBook.Close SaveChanges:=False            Next            Application.ScreenUpdating = True            Application.Calculation = xlCalculationAutomatic            MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"        End If    Else        MsgBox "No files selected", Title:="Merge Excel files"    End IfEnd Sub

另一答案

经过一番试验和错误后，我设法将两个宏组合起来。我在这里找到了一个类似的问题，并使用了其中一个答案并将其改为我的需求。

我将此添加到MergeExcelFiles宏：

wbkCurBook.Sheets(wbkCurBook.Sheets.Count).Name = Left$(wbkSrcBook.Name, InStrRev(wbkSrcBook.Name, ".") - 22)

现在，在执行宏以合并文件时重命名文件：

Sub MergeAndRenameExcelFiles()Dim fnameList, fnameCurFile As VariantDim countFiles, countSheets As IntegerDim wksCurSheet As WorksheetDim wbkCurBook, wbkSrcBook As WorkbookfnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)If (vbBoolean <> VarType(fnameList)) Then    If (UBound(fnameList) > 0) Then        countFiles = 0        countSheets = 0        Application.ScreenUpdating = False        Application.Calculation = xlCalculationManual        Set wbkCurBook = ActiveWorkbook        For Each fnameCurFile In fnameList            countFiles = countFiles + 1            Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)            For Each wksCurSheet In wbkSrcBook.Sheets                countSheets = countSheets + 1                wksCurSheet.Copy After:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)                wbkCurBook.Sheets(wbkCurBook.Sheets.Count).Name = Left$(wbkSrcBook.Name, InStrRev(wbkSrcBook.Name, ".") - 22)            Next            wbkSrcBook.Close SaveChanges:=False        Next        Application.ScreenUpdating = True        Application.Calculation = xlCalculationAutomatic        MsgBox "Procesed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"    End IfElse    MsgBox "No files selected", Title:="Merge Excel files"End If

结束子

以上是关于Excel VBA - 组合宏以重命名工作表和宏以在一个宏中合并工作表的主要内容，如果未能解决你的问题，请参考以下文章