Ir ao conteúdo
  • Comunicados

    • Gabriel Torres

      Seja um moderador do Clube do Hardware!   12-02-2016

      Prezados membros do Clube do Hardware, Está aberto o processo de seleção de novos moderadores para diversos setores ou áreas do Clube do Hardware. Os requisitos são:   Pelo menos 500 posts e um ano de cadastro; Boa frequência de participação; Ser respeitoso, cordial e educado com os demais membros; Ter bom nível de português; Ter razoável conhecimento da área em que pretende atuar; Saber trabalhar em equipe (com os moderadores, coordenadores e administradores).   Os interessados deverão enviar uma mensagem privada para o usuário @Equipe Clube do Hardware com o título "Candidato a moderador". A mensagem deverá conter respostas às perguntas abaixo:   Qual o seu nome completo? Qual sua data de nascimento? Qual sua formação/profissão? Já atuou como moderador em algo outro fórum, se sim, qual? De forma sucinta, explique o porquê de querer ser moderador do fórum e conte-nos um pouco sobre você.   OBS: Não se trata de função remunerada. Todos que fazem parte do staff são voluntários.
    • DiF

      Poste seus códigos corretamente!   21-05-2016

      Prezados membros do Fórum do Clube do Hardware, O Fórum oferece um recurso chamado CODE, onde o ícone no painel do editor é  <>     O uso deste recurso é  imprescindível para uma melhor leitura, manter a organização, diferenciar de texto comum e principalmente evitar que os compiladores e IDEs acusem erro ao colar um código copiado daqui. Portanto convido-lhes para ler as instruções de como usar este recurso CODE neste tópico:  
Jéssica De Moura Lima

Excel Importar dados de arquivos externos

Recommended Posts

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?

Compartilhar este post


Link para o post
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

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário






Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações 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

×