VBA将文件夹中的所有Excel文件复制到单个文件会导致运行时错误

时间:2016-09-20 21:47:21

标签: excel vba

我正在尝试使用VBA打开目录中的所有excel文件(在本例中为c:\ temp),并将所有文件数据表放在一个大文件中。每个新工作表都使用文件名和原始文档上工作表的名称命名。我有的代码复制了第一个文件的第一张表,甚至正确命名,但是当我尝试设置名称时,第二张表上的运行时错误1004:应用程序定义或对象定义错误失败。任何人都有任何关于如何修复的建议。

Sub MergeAllWorkbooks()
Dim FolderPath As String
Dim FileName As String

' Create a new workbook
Set FileWorkbook = Workbooks.Add(xlWBATWorksheet)

' folder path to the files you want to use.
FolderPath = "C:\Temp\"

' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")

' Loop until Dir returns an empty string.
Do While FileName <> ""

    ' Open a workbook in the folder
    Set WorkBk = Workbooks.Open(FolderPath & FileName)

    Dim currentSheet As Worksheet
    Dim sheetIndex As Integer
    sheetIndex = 1

    Windows(WorkBk.Name).Activate

    For Each currentSheet In WorkBk.Worksheets
        currentSheet.Select
        currentSheet.Copy Before:=Workbooks(FileWorkbook.Name).Sheets(sheetIndex)
        FileWorkbook.Sheets(sheetIndex).Name = FileName & "-" & currentSheet.Name
        sheetIndex = sheetIndex + 1
    Next currentSheet

    ' Close the source workbook without saving changes.
    WorkBk.Close savechanges:=False

    ' Use Dir to get the next file name.
    FileName = Dir()
Loop

End Sub

1 个答案:

答案 0 :(得分:1)

替换

List<T>

with(我把它分开以便于阅读)

FileWorkbook.Sheets(sheetIndex).Name = FileName & "-" & currentSheet.Name

您需要定义sWSName。

以下是我之前使用的修改过的功能。

sWSName = FileName & "-" & currentSheet.Name
sWSName = NameTest(sWSName)
sWSName = TestDup(sWSName)
FileWorkbook.Sheets(sheetIndex).Name = sWSName

如果发布此代码(或在此范围内)不合适,请告诉我,因为我仍然需要努力程度要求和合理回应。