將工作簿合並到主工作簿中，每個文件都有單獨的工作表

Question

我的文件夾中有30個xlsx文件，我希望所有這些文件的第一張紙都合並到一個新的工作簿中。 問題是我不希望宏像Ron的excel合並工具一樣將值復制粘貼到新的主表的同一張表中。 我希望宏在主文件上創建新的30張紙並從源文件復制數據。 我希望將新添加的工作表重命名為源文件名。 我在論壇上搜索了幾個小時，發現以下代碼。 除工作表重命名外，此方法效果很好。 有人可以調查一下代碼，請幫助我將工作表重命名部分添加到代碼中嗎？

Sub Merge2MultiSheets()
    Dim wbDst As Workbook
    Dim wbSrc As Workbook
    Dim wsSrc As Worksheet
    Dim MyPath As String
    Dim strFileName As String

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    MyPath = "C:\Jude" ' change to suit
    Set wbDst = Workbooks.Add(xlWBATWorksheet)
    strFileName = Dir(MyPath & "\*.xlsx", vbNormal)

    If Len(strFileName) = 0 Then Exit Sub

    Do Until strFileName = ""

            Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFileName)

            Set wsSrc = wbSrc.Worksheets(1)

            wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)

           wbSrc.Close False

        strFileName = Dir()

    Loop
    wbDst.Worksheets(1).Delete

    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Answer 1

wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)

wbDst.Worksheets(wbDst.Worksheets.Count).Name = strFileName

如果要包含路徑，則需要刪除反斜杠“ \\”和所有其他無效的工作表名稱字符。

確保名稱不包含以下任何字符：：\\ /？ * [ 要么 ]