Невозможно объединить файлы Excel с тем же именем листа

Question

Я довольно новичок в кодировании VB и пытаюсь объединить электронные таблицы Excel, а затем объединить данные в одну электронную таблицу.Я нашел этот код , который работал идеально, пока я не столкнулся с файлами с тем же именем рабочего листа.

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

При запуске этого кода я получаю

ошибка 1004: невозможно переименовать лист в тот же лист, библиотеку объектов или рабочую книгу, на которую ссылается Visual Basic.

Мне нужна помощь в переименовании рабочих листов по мере их поступленияимпортирован.

Answer 1

В Excel2016 эту проблему невозможно создать заново, поскольку Excel автоматически добавляет «(1)», «(2)» ... к имени листа, имя которого совпадает с именем скопированного листа.

Если вы используете более старую версию Excel, решение этой проблемы потребует воссоздания этого поведения.

Чтобы переименовать лист, я ссылаюсь на этот ответ: Переименование листа Excel с помощью if sheetимя уже существует

Создайте новую функцию для проверки имен листов в обеих книгах:

Private Function VerifySheetName(ByVal sourceWorkbook As Workbook, ByVal targetWorkbook As Workbook, ByVal sheetName As String) As String
Dim combinedSheets As New Collection
Dim tempSheet As Worksheet

For Each tempSheet In sourceWorkbook.Sheets
    combinedSheets.Add tempSheet
Next tempSheet

For Each tempSheet In targetWorkbook.Sheets
    combinedSheets.Add tempSheet
Next tempSheet

For Each tempSheet In combinedSheets
    If tempSheet.Name = sheetName Then
        VerifySheetName = sheetName & "_" & combinedSheets.Count
    End If
Next tempSheet

End Function

Вызовите эту функцию в цикле:

For Each wksCurSheet In wbkSrcBook.Sheets
tempSheetName = VerifySheetName(wbkSrcBook, wbkCurBook, wksCurSheet.Name)
If Not wksCurSheet.Name = tempSheetName Then
    wksCurSheet.Name = tempSheetName
End If

countSheets = countSheets + 1
wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
Next 

Ине забудьте добавить новое объявление переменной, если вы используете Option Explicit (вам следует!)

Dim tempSheetName As String

PS При инициализации нескольких переменных в одной строке, если вы опускаете тип переменной, по умолчаниюон приведен как вариант:

Dim countFiles, countSheets As Integer

В этом случае countFiles имеет вариантный тип, а countSheets имеет целочисленный тип.Если вам нужен явный тип переменной, вам нужно назначить тип каждой переменной:

Dim countFiles as Integer, countSheets As Integer