合并文件

Question

我有200多个需要合并的工作簿，下面的代码将合并这些工作簿并将所有工作表添加到一个工作簿中。

在该工作簿中，工作表被命名为Sheet 1 (1)，Sheet 1 (2)，依此类推。

如果从Workbook1复制工作表，则工作表名称将为workbook 1

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)
        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

在您的For Each循环中添加

Dim j as integer ‘Add to top of your sub
j = 0 ‘Add inside for loop 

For Each tempWorkSheet In sourceWorkbook.Worksheets
    j= j+1
    tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
    ActiveSheet.Name = sourceWorkBook.Name & “ - “ & j ‘Added Line of code to rename copied tab
Next tempWorkSheet

只要您的工作簿名称不太长或不重复，就应该很好

Answer 2

合并文件

代码问题

您已将numberOfFilesChosen声明为Variant：

Dim numberOfFilesChosen, i As Integer ' Wrong

Dim numberOfFilesChosen as Integer, i As Integer ' OK

您已将mainWorkbook声明为Variant：

Dim mainWorkbook, sourceWorkbook As Workbook ' Wrong

Dim mainWorkbook as Workbook, sourceWorkbook As Workbook ' OK

这样的代码应该在工作簿（mainWorkbook）中，其中工作表正在导入，因此您不需要变量，只需使用 ThisWorkbook。然后结合With语句，您可以可以使用例如.Sheets(.Sheets.Count)。

您正在工作表和工作表之间切换。当您使用mainWorkbook.Worksheets.Count时，这不一定是最后一张纸，因此使用mainWorkbook.Sheets.Count会更正确，尤其是为了使添加的工作表计数器正常工作。

tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)

tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Sheets.Count) ' Preferable

使用sourceWorkbook.Close时，可能会要求您保存工作簿。使用

sourceWorkbook.Close False ' Preferable

将关闭工作簿而不保存更改。

如果再次运行该代码，则该代码将失败，因为工作表名称它会尝试创建的都是一样的。因此，我添加了我在测试代码时使用的DeleteWorksheetsExceptOne。

代码

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

    'Define variables:
    Dim tempFileDialog As FileDialog
    Dim sourceWorkbook As Workbook
    Dim tempWorkSheet As Worksheet
    Dim numberOfFilesChosen As Long, i As Long, j As Long

    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

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

    With ThisWorkbook
        'Loop through all selected workbooks
        For i = 1 To tempFileDialog.SelectedItems.Count
            'Open each workbook
            Workbooks.Open tempFileDialog.SelectedItems(i)
            Set sourceWorkbook = ActiveWorkbook
            j = 0

            'Copy each worksheet to the end of the main workbook
            For Each tempWorkSheet In sourceWorkbook.Worksheets
                j = j + 1
                tempWorkSheet.Copy After:=.Sheets(.Sheets.Count)
                ' Rename newly added worksheet to the name of Source Workbook
                ' concatenated with "-" and Counter (j).
                .Sheets(.Sheets.Count).Name = sourceWorkbook.Name & "-" & j
            Next

            'Close the source workbook. False for not saving changes.
            sourceWorkbook.Close False
        Next
    End With

End Sub

删除除一个以外的所有工作表

'*******************************************************************************
' Purpose:  Deletes all Worksheets in the ActiveWorkbook except one.
' Danger:   This code doesn't ask anything, it just does. In the end you will
'           end up with just one worksheet (cStrWsExcept) in the workbook
'           (cStrWbPath). If you have executed this code and the result is not
'           satisfactory, just close the workbook and try again or don't. There
'           will be no alert like "Do you want to save ..." because of the line:
'           ".Saved = True" i.e. "objWb.Saved = True".
' Arguments (As Constants):
'   cStrWbPath
'     The path of the workbook to be processed. If "", then ActiveWorkbook is
'     used.
'   cStrWsExcept
'     The worksheet not to be deleted. If "", then the Activesheet is used.
'*******************************************************************************
Sub DeleteWorksheetsExceptOne()

  Const cStrWbPath = ""          ' if "" then ActiveWorkbook
  Const cStrWsExcept = "Sheet1"  ' if "" then ActiveSheet

  Dim objWb As Workbook
  Dim objWsExcept As Worksheet
  Dim objWsDelete As Worksheet

  If cStrWbPath = "" Then
    Set objWb = ActiveWorkbook
   Else
    Set objWb = Workbooks(cStrWbPath)
  End If

  With objWb
    If cStrWsExcept = "" Then
      Set objWsExcept = .ActiveSheet
     Else
      Set objWsExcept = .Worksheets(cStrWsExcept)
    End If

    ' To suppress the "Data may exist in the sheet(s) selected for deletion.
    '                  To permanently delete the data, press Delete." - Alert:
    Application.DisplayAlerts = False

      For Each objWsDelete In .Worksheets
        If objWsDelete.Name <> objWsExcept.Name Then
          objWsDelete.Delete
        End If
      Next

      ' To suppress the "Do you want to save changes you made to ... ?" - Alert:
      .Saved = True

    Application.DisplayAlerts = True

  End With

End Sub
'*******************************************************************************

合并后用工作簿名称命名工作表吗？

2 个答案:

合并文件

代码问题

代码

删除除一个以外的所有工作表