合並后用工作簿名稱命名工作表嗎？

Question

我已經合並了200多個工作簿，下面的代碼將合並這些工作簿並將所有工作表添加到一個工作簿中。

在該工作簿中，工作表被命名為工作Sheet 1 (1) ，工作Sheet 1 (2) ，依此類推。

如果從Workbook1 workbook 1復制Workbook1表，則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更為正確，尤其是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
'*******************************************************************************