Ir ao conteúdo

Posts recomendados

Postado

Prezados,

 

Desejo copiar dados de um intervalo de células, gerar outro arquivo de Excel e salvá-la em local específico.

 

Aparece "Erro em tempo de execução '1004'   O método Select da classe Range falhou" quando tento executar o código.

 

Sub Salvar_dados()

 

'Copiar e colar como valores

Sheets("Base de Contratos").Range("B12:CN100000").Select
Selection.Copy
Application.DisplayAlerts = False
Sheets("Relatório").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Base de Contratos").Activate


'Gerar relatório de dados

Sheets("Relatório").Copy
Application.DisplayAlerts = False

ActiveWorkbook.SaveAs Filename:="C:\Users\User\Documents\Relatório\" & "report" & "_" & Format(Now, "m.dd.yy hhmm") & ".xlsx"
ActiveWorkbook.Close

End Sub

 

Alguém poderia me ajudar?

Postado

@Jéssica De Moura Lima acho que sim. 

 

Veja se é isso que deseja.

 

Sub Salvar_dados()
    Dim wbNew As Workbook
    Dim wb1 As Workbook
    Dim wsN1 As Worksheet
    
    Set wbNew = Excel.Application.Workbooks.Add(1)
    Set wb1 = ThisWorkbook
    Set wsN1 = wbNew.Sheets(1)
    
    'Copiar e colar como valores
    With wb1.Sheets("Base de Contratos")
        .Activate
        .Range("B12:CN100000").Select
        Selection.Copy
        Application.DisplayAlerts = False
        
        With wsN1
            .Activate
            .Range("A1").Select
            .Name = "Relatório"
        End With
        
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        wb1.Sheets("Base de Contratos").Activate
        
        'Gerar relatório de dados
        Application.DisplayAlerts = False
        
        wbNew.SaveAs Filename:="C:\Users\User\Documents\Relatório\" & "report" & "_" & Format(Now, "m.dd.yy hhmm") & _
                               ".xlsx", FileFormat:=51
        
        Application.DisplayAlerts = True
        
        .Range("A1").Select
        
        wbNew.Close
        
    End With
End Sub

 

Postado

@Basole deu certo! Muito obrigada!!!

 

Eu também gostaria de importar os dados do relatório gerado para outra planilha, mas não está funcionando.

 

Sub Importar_dados()

Dim importado As Excel.Workbook
Set importado = Workbooks.Open("C:\Users\User\Documents\Relatório\Report.xlsx", Password:="123")

Application.ScreenUpdating = False

 

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

 

'Limpar guia "Relatório"
Sheets("Dados").Visible = True
Sheets("Dados").Select
Selection.ClearContents

 

'Importar relatório de dados
importado.Sheets("Relatório").Copy

ThisWorkbook.Sheets("Dados").Paste

importado.Close

 

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

Sheets("Contratos a Faturar").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 sabe o que pode estar acontecendo?

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...

LANÇAMENTO!

eletronica2025-popup.jpg


CLIQUE AQUI E BAIXE AGORA MESMO!