首页 > 解决方案 > 宏崩溃 Excel

问题描述

我需要一个将一百个不同工作簿中的数据收集到一张工作表中的宏。这就是我想出的。可悲的是,当我尝试运行 Excel 时它崩溃并且没有显示错误消息。

Sub Cop()

Dim lin As Integer
Dim myfolder As String 
Dim myfile As String 
Dim proj As String 
Dim master As Workbook 
Dim controle As Worksheet 
Dim fonte As Worksheet

Set master = ThisWorkbook 
Set controle = master.Worksheets("Controle Meta 2024 - Plus")

lin = 5

myfolder = "R:\2. XYZ\Empresas\ABC\1. Mandato\1. Informações\1. Informações Recebidas\Projeções Lançamentos 2020-2024\DE-PARA"

For i = 1 To 118
    proj = master.Worksheets("Controle Meta 2024 - Plus").Cells(lin, 2)
    myfile = Dir(myfolder & proj & "\*.xlsx")
    On Error GoTo Erro
    Workbooks.Open Filename:=myfile
    Set fonte = Workbooks(myfile).Worksheets("DADOS")
    master.controle.Cells(lin, 70) = Workbooks(myfile).fonte.Range("E7")
    master.controle.Cells(lin, 71) = Workbooks(myfile).fonte.Range("E6")
    Workbooks(myfile).Close SaveChanges:=False
    lin = lin + 1 

Prox:
    Next i 

Erro:
    Resume Prox

End Sub

谢谢!

标签: excelvba

解决方案


未经测试:

Sub Cop()

    'Use constants for fixed values
    Const MYFOLDER As String = "R:\2. XYZ\Empresas\ABC\1. Mandato\1. Informações\1. " & _
           "Informações Recebidas\Projeções Lançamentos 2020-2024\DE-PARA"

    Dim myfile As String, proj As String, i As Long
    Dim controle As Worksheet, fonte As Worksheet

    Set controle = ThisWorkbook.Worksheets("Controle Meta 2024 - Plus")

    For i = 5 To 123
        proj = controle.Cells(i, 2).Value
        myfile = Dir(MYFOLDER & proj & "\*.xlsx")
        If Len(myfile) > 0 Then '<<< is there a matching file?
            With Workbooks.Open(Filename:=myfile)
                Set fonte = .Worksheets("DADOS")
                controle.Cells(i, 70) = fonte.Range("E7").Value
                controle.Cells(i, 71) = fonte.Range("E6").Value
                .Close SaveChanges:=False
            End With
        End If
    Next i

End Sub

推荐阅读