Ir ao conteúdo
  • Cadastre-se

Excel Importar dados de arquivos externos


Posts recomendados

Olá!

 

Gostaria de importar dados de um arquivo externo, mas o meu código não está funcionando.

 

 

Sub Importar()

 

Dim Abrir As String
Dim Importarwb As Workbook
Dim Importarguia As Worksheet

 

Abrir = Application.GetOpenFilename( _
FileFilter:="Arquivo do Excel (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Escolha o arquivo a ser importado")

 

Set Importarwb = Application.Workbooks.Open( _
Filename:=Abrir, Password:="123")

 

Set Importarguia = Importarwb.Worksheets(1)

 

Application.ScreenUpdating = False

 

'Desbloquear guia e pasta de trabalho
ThisWorkbook.Unprotect ("123")
ActiveSheet.Unprotect ("123")

 

'Copiar dados
Importarguia.Copy

 

'Limpar guia "Relatório" e colar dados
Worksheets("Relatório").Visible = True

With Worksheets("Relatório")
    .Visible = True
    .Range(.Cells(1, 1), .Cells(10000, 90)).ClearContents
    .Paste
    .Visible = False
    
End With

 

'Fechar arquivo externo
Importarwb.Close

 

'Bloquear guia e pasta de trabalho
ThisWorkbook.Protect Password:="123", Structure:=True, Windows:=False

 

Sheets("Base de Contratos").Protect Password:="123", _
    DrawingObjects:=True, _
    Contents:=True, _
    Scenarios:=True, _
    UserInterfaceOnly:=True, _
    AllowFormattingCells:=False, _
    AllowFormattingColumns:=False, _
    AllowFormattingRows:=True, _

    AllowInsertingColumns:=False, _
    AllowInsertingRows:=True, _
    AllowInsertingHyperlinks:=False, _
    AllowDeletingColumns:=False, _
    AllowDeletingRows:=True, _
    AllowSorting:=False, _
    AllowFiltering:=True, _
    AllowUsingPivotTables:=False

 

Application.ScreenUpdating = True

 

MsgBox "Relatório importado com sucesso!"

 

End Sub

 

Alguém poderia me ajudar?

Link para o comentário
Compartilhar em outros sites

@Jéssica De Moura Lima fiz as alterações,mas não tive como testar,

 

Veja se é isso e de retorno por favor.

.

Sub Importar()
    Dim Abrir As String
    Dim Importarwb As Workbook
    Dim Importarguia As Worksheet
    Dim xlObj As Object
    
    On Error GoTo trataErro
    
    Set xlObj = CreateObject("excel.application")
    
    
    Abrir = Application.GetOpenFilename( _
    FileFilter:="Arquivo do Excel (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Escolha o arquivo a ser importado")
    
    Set Importarwb = xlObj.Workbooks.Open( _
    Filename:=Abrir, Password:="123")
    
    Set Importarguia = Importarwb.Worksheets(1)
    
    Application.ScreenUpdating = False
    
    'Desbloquear guia e pasta de trabalho
    ThisWorkbook.Unprotect ("123")
    ActiveSheet.Unprotect ("123")
    
    'Copiar dados
    Importarguia.UsedRange.Copy
    
    'Limpar guia "Relatório" e colar dados
    ThisWorkbook.Worksheets("Relatório").Visible = True
    
    With Worksheets("Relatório")
        .Activate
        .Range(.Cells(1, 1), .Cells(10000, 90)).ClearContents
        .Cells(1, 1).Select
        .Paste
        .Visible = False
    End With
    
    Importarwb.Application.CutCopyMode = False
    
    
    'Fechar arquivo externo
    If Not Importarwb Is Nothing Then
        Importarwb.Close False
        Set Importarwb = Nothing
        Set xlObj = Nothing
    End If
    
    'Bloquear guia e pasta de trabalho
    ThisWorkbook.Protect Password:="123", Structure:=True, Windows:=False
    
    Sheets("Base de Contratos").Protect Password:="123", _
    DrawingObjects:=True, _
    Contents:=True, _
    Scenarios:=True, _
    UserInterfaceOnly:=True, _
    AllowFormattingCells:=False, _
    AllowFormattingColumns:=False, _
    AllowFormattingRows:=True, _
    AllowInsertingColumns:=False, _
    AllowInsertingRows:=True, _
    AllowInsertingHyperlinks:=False, _
    AllowDeletingColumns:=False, _
    AllowDeletingRows:=True, _
    AllowSorting:=False, _
    AllowFiltering:=True, _
    AllowUsingPivotTables:=False
    
trataErro:
    Application.ScreenUpdating = True
    If Not Importarwb Is Nothing Then
        Importarwb.Close False
        Set Importarwb = Nothing
        Set xlObj = Nothing
    End If
    
    
    MsgBox "Relatório importado com sucesso!"
    
End Sub

 

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...