Olá caros, boa tarde!
Tenho uma rotina pronta para abrir arquivos pré-determinados em células, e executar um comando para atualizar todas as Tabelas Dinâmicas, salvar e fechar.
É simples, e a rotina está pronta, conforme código abaixo:
Private Sub AtualizarBD()
Loc01 = Sheets("OP").Range("B16")
Loc02 = Sheets("OP").Range("B17")
Loc03 = Sheets("OP").Range("B18")
Loc04 = Sheets("OP").Range("B19")
Loc05 = Sheets("OP").Range("B20")
Loc06 = Sheets("OP").Range("B21")
Loc07 = Sheets("OP").Range("B22")
Loc08 = Sheets("OP").Range("B23")
Loc09 = Sheets("OP").Range("B24")
Loc10 = Sheets("OP").Range("B25")
Arq01 = Sheets("OP").Range("D16")
Arq02 = Sheets("OP").Range("D17")
Arq03 = Sheets("OP").Range("D18")
Arq04 = Sheets("OP").Range("D19")
Arq05 = Sheets("OP").Range("D20")
Arq06 = Sheets("OP").Range("D21")
Arq07 = Sheets("OP").Range("D22")
Arq08 = Sheets("OP").Range("D23")
Arq09 = Sheets("OP").Range("D24")
Arq10 = Sheets("OP").Range("D25")
decisao = MsgBox("Deseja ATUALIZAR todos os bancos de dados?", vbYesNo, "AVISO")
If decisao = vbYes Then
'Arquivo 01
If Loc01 = "" And Arq01 = "" Then GoTo Next02
Workbooks.Open Filename:=Loc01 & Arq01
ActiveWorkbook.RefreshAll
Windows(Arq01).Close True
Next02:
'Arquivo 02
If Loc02 = "" And Arq02 = "" Then GoTo Next03
Workbooks.Open Filename:=Loc02 & Arq02
ActiveWorkbook.RefreshAll
Windows(Arq02).Close True
Next03:
'Arquivo 03
If Loc03 = "" And Arq03 = "" Then GoTo Next04
Workbooks.Open Filename:=Loc03 & Arq03
ActiveWorkbook.RefreshAll
Windows(Arq03).Close True
Next04:
'Arquivo 04
If Loc04 = "" And Arq04 = "" Then GoTo Next05
Workbooks.Open Filename:=Loc04 & Arq04
ActiveWorkbook.RefreshAll
Windows(Arq04).Close True
Next05:
'Arquivo 05
If Loc05 = "" And Arq05 = "" Then GoTo Next06
Workbooks.Open Filename:=Loc05 & Arq05
ActiveWorkbook.RefreshAll
Windows(Arq05).Close True
Next06:
'Arquivo 06
If Loc06 = "" And Arq06 = "" Then GoTo Next07
Workbooks.Open Filename:=Loc06 & Arq06
ActiveWorkbook.RefreshAll
Windows(Arq06).Close True
Next07:
'Arquivo 07
If Loc07 = "" And Arq07 = "" Then GoTo Next08
Workbooks.Open Filename:=Loc07 & Arq07
ActiveWorkbook.RefreshAll
Windows(Arq07).Close True
Next08:
'Arquivo 08
If Loc08 = "" And Arq08 = "" Then GoTo Next09
Workbooks.Open Filename:=Loc08 & Arq08
ActiveWorkbook.RefreshAll
Windows(Arq08).Close True
Next09:
'Arquivo 09
If Loc09 = "" And Arq09 = "" Then GoTo Next10
Workbooks.Open Filename:=Loc09 & Arq09
ActiveWorkbook.RefreshAll
Windows(Arq09).Close True
Next10:
'Arquivo 10
If Loc10 = "" And Arq10 = "" Then GoTo FINAL
Workbooks.Open Filename:=Loc10 & Arq10
ActiveWorkbook.RefreshAll
Windows(Arq10).Close True
FINAL:
MsgBox "TODAS AS BASES DE DADOS FORAM ATUALIZADAS COM SUCESSO!"
' Atualizar data e hora
Sheets("CAPA").Select
ActiveSheet.Unprotect
Range("J20").Select
Selection.ClearContents
ActiveCell.FormulaR1C1 = "=TEXT(NOW(),""dd"")&"" / ""&PROPER(TEXT(NOW(),""mmm""))&"" / ""&TEXT(NOW(),""aaaa"")&"" | ""&TEXT(NOW(),""hh:mm;@"")"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End Sub
O problema é: Esse código está muito grande, e não tenho expertise para otimizá-lo. Eu sei que tem como o VBA verificar linha por linhas, até achar uma vazia, e parar... MAs não sei como fazer.
Alguém pode me ajudar nessa tarefa?
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 19/10/2011 12:38 pm