VBA在选择中打开多个文件以复制到主表中

时间:2016-10-12 07:29:08

标签: excel vba excel-vba

我在VBA(excel)中创建了一个宏来打开每日文件的特定范围,所有文件都具有类似的名称开头(9489),后跟文件特定日期(DD-MM-YY)。然后将选择内容复制到主文件(Masterfile.xlsm)中,对该目录中的所有文件运行此子目录。

从今天起,我不断收到名为&#34的错误;运行时错误1004:9489 150116找不到每日Dashboard.xlsx。检查文件名的拼写,并验证文件位置是否正确。"

为什么会出现此错误?最重要的是,任何人都可以帮我解决这个错误吗?我没有更改文件的拼写或文件位置!

代码:

Sub LoopThroughDirectory() 
Dim Myfile As String 
Dim erow 
Myfile = Dir("F:\WGD\Dep 408101-Se-DCIFINK-009786\Consolidatie & Regulatory Reporting\Regulatory Reporting\Daily dashboard of Ratios\Test Daily Dashboard\")
Application.DisplayAlerts = False

Do While Len(Myfile) > 0 
If Myfile = "Masterfile.xlsm" Then

Exit Sub

End If

Workbooks.Open (Myfile) 
Worksheets("Liquidity Reporting").Range("A2:E19").Copy

Windows("Masterfile.xlsm").Activate 
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 5))

Workbooks(Myfile).Application.CutCopyMode = False 
Workbooks(Myfile).Close SaveChanges:=False

Myfile = Dir

Loop

End Sub

1 个答案:

答案 0 :(得分:2)

Excel无法找到该文件的原因是MyFile只是文件名;您还需要包含该文件路径。

这一行:ActiveSheet.Paste Destination...会抛出错误。

尽量避免选择并激活。

使用复制和粘贴时无需调整范围大小。您只需要定位目标范围的左上角单元格。

Sub LoopThroughDirectory()

    Const FOLDERPATH = "F:\WGD\Dep 408101-Se-DCIFINK-009786\Consolidatie & Regulatory Reporting\Regulatory Reporting\Daily dashboard of Ratios\Test Daily Dashboard\"
    Dim Myfile As String
    Dim Source As Range, Target As Range

    Myfile = Dir(FOLDERPATH)
    Application.DisplayAlerts = False

    Do While Len(Myfile) > 0
        If Myfile <> "Masterfile.xlsm" Then
            With Worksheets("Sheet1")
                Set Target = .Range("A" & .Rows.Count).End(xlUp).Offset(1)
            End With

            With Workbooks.Open(FOLDERPATH & Myfile)

                Set Source = .Worksheets("Liquidity Reporting").Range("A2:E19")
                Source.Copy Destination:=Target
                .Close SaveChanges:=False

            End With

        End If
        Myfile = Dir
    Loop

End Sub