将数据从一个excel文件复制到另一个excel文件 - 下标超出范围

时间:2015-08-20 14:55:32

标签: excel

我在下面的代码中我试图将excel文件数据复制到不同的excel文件中但是我收到错误:运行时错误' 9'下标超出范围

Sub Button1_Click()
Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = "\\test\CheckFile"
fileName = "test2.xlsx"

Do While fileName <> ""
Workbooks.Open (fileName)
For Each sheet In Workbooks(fileName).Worksheets
 total = Workbooks("Book1.xlt").Worksheets.Count
 Workbooks(fileName).Worksheets(sheet.Name).Copy _  //error appears here
 after:=Workbooks("Book1.xlt").Worksheets(total)
Next sheet

Workbooks(fileName).Close
fileName = Dir()
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

1 个答案:

答案 0 :(得分:0)

好的,我已经重新回复了您的最新信息。我创建了这个文件夹:C:\test\CheckFile。里面有两个excel文件,都保存为.xlsx。我创建了一个空的PAY.xlsm并将其保存在其他地方(即不在test \ CheckFile目录中)。在运行代码之前我打开了PAY.xlsm。

我认为模板文件.xlt会导致问题。他们用不同的名字打开。当Workbooks.Open (fileName)打开Book2.xlt时,它会以Book21.xlsx打开。然后导致下标超出范围错误。

然后我运行了这段代码并且工作正常:

Sub Button1_Click()
    Dim directory As String, fileName As String, sheet As Worksheet, total As Integer

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    directory = "C:\test\checkfile\"
    fileName = Dir(directory)

    Do While fileName <> ""
        Workbooks.Open (fileName)

        For Each sheet In Workbooks(fileName).Worksheets
             total = Workbooks("PAY.xlsm").Worksheets.Count

              Workbooks(fileName).Worksheets(sheet.Name).Copy _
             after:=Workbooks("PAY.xlsm").Worksheets(total)
        Next sheet
        Workbooks(fileName).Close
        fileName = Dir()
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True


End Sub