Excel vba：合并具有相同名称的工作簿

Question

我使用此代码将更多工作簿合并到一个文件中。 我发现的问题是我有几个具有相同名称的工作表，并且代码将停止。 知道如何解决此问题吗？ 例如，如果我有两个名称为“ Sheet123”的工作表，程序将停止。

 Sub mergeFiles()
'Merges all files in a folder to a main file.

 'Define variables:
  Dim numberOfFilesChosen, i As Integer
  Dim tempFileDialog As FileDialog
  Dim mainWorkbook, sourceWorkbook As Workbook
  Dim tempWorkSheet As Worksheet

  Set mainWorkbook = Application.ActiveWorkbook
  Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

  'Allow the user to select multiple workbooks
   tempFileDialog.AllowMultiSelect = True

   numberOfFilesChosen = tempFileDialog.Show

   'Loop through all selected workbooks
   For i = 1 To tempFileDialog.SelectedItems.Count

    'Open each workbook
    Workbooks.Open tempFileDialog.SelectedItems(i), Local:=True

    Set sourceWorkbook = ActiveWorkbook

    'Copy each worksheet to the end of the main workbook
    For Each tempWorkSheet In sourceWorkbook.Worksheets
        tempWorkSheet.Copy After:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
    Next tempWorkSheet

    'Close the source workbook
    sourceWorkbook.Close
Next i

End Sub

Answer 1

让我们假设您创建了一个控制表，您可以尝试：

Option Explicit

Sub Loop_Sheets()

    Dim ws As Worksheet
    Dim LastRow As Long
    Dim wsName As String
    Dim wsList As Range, cell As Range
    Dim Excist As Boolean

    'Loop worksheets
    For Each ws In ThisWorkbook.Worksheets

        'Get Sheet name
        wsName = ws.Name

        With ThisWorkbook.Worksheets("Control")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

            If LastRow = 1 Then
                .Cells(LastRow + 1, 1).Value = wsName
            Else
                'Set the list with worksheet names
                Set wsList = .Range(Cells(2, 1), Cells(LastRow, 1))

                Excist = False

                For Each cell In wsList
                    'Loop through list
                    If wsName = cell Then
                        Excist = True
                        Exit For
                    End If

                Next

                'If sheet appears in the list
                If Excist = True Then
                'Code'
                'If sheet dont appears in the list
                Else
                    .Cells(LastRow + 1, 1).Value = wsName
                    'Code'
                End If
            End If

        End With

    Next

End Sub