我需要一个宏,该宏将来自一百个不同工作簿的数据收集到一张纸中。这就是我想出的。可悲的是,当我尝试运行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
谢谢!
答案 0 :(得分:0)
尝试以下代码, 罗恩(Ron)在OnError中隐藏了错误(这就是为什么您没有收到错误消息的原因)
您错误地使用了DIR()函数,请参见下文。而While外观的“ while”循环比“ For”循环更有效
`Sub Cop()
Dim lin As Integer
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"
myfile = Dir(myfolder & proj & "\*.xlsx")
While myfile <> ""
proj = master.Worksheets("Controle Meta 2024 - Plus").Cells(lin, 2)
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
myfile = Dir()
Prox:
Wend
Erro:
Resume Prox
End Sub`
答案 1 :(得分:0)
未经测试:
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