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