Question

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

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

对于第一个宏，我打开每个excel文件，运行宏，然后关闭并再次保存excel文件。对于第二个宏，我打开一个仅包含合并宏的示例excel文件。我从该文件运行合并宏，它要求我选择要合并的文件。我要合并的文件需要在那时关闭。

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

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

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

这些是我当前使用的宏：

Macro 1重命名工作表：

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

Macro 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 If
End Sub

Answer 1

您可以将它们分开，而不必将它们合并在一起，而不是合并宏：

Sub RunMyMacros()

RenameSheet
MergeExcelFiles

End 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 If
End Sub

Answer 2

经过反复试验，我设法将两个宏组合在一起。我在这里找到了类似的问题，并使用其中一个答案，将其更改为我的需要。

我将其添加到MergeExcelFiles宏：

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

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

Sub MergeAndRenameExcelFiles()
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)
                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 If

Else
    MsgBox "No files selected", Title:="Merge Excel files"
End If

结束子

Excel VBA-合并宏以重命名工作表，并合并宏以在一个宏中合并工作表

2 个答案: