Excel vba: объединить книги с одинаковыми именами - PullRequest
0 голосов
/ 22 января 2019

Я использую этот код для объединения нескольких рабочих книг в один файл. Проблема, которую я обнаружил, состоит в том, что у меня есть несколько листов с одинаковым именем, и код остановится. Любая идея, как я могу решить эту проблему? Например, если у меня есть 2 листа с именем «Лист123», программа остановится.

 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

1 Ответ

0 голосов
/ 22 января 2019

Предположим, что вы создали контрольный лист, вы можете попробовать:

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...