Ir ao conteúdo
  • Cadastre-se
Etoruiz

Excel RESOLVIDO Copiar Range com Inputbox no Excel

Posts recomendados

Bom dia galera!

 

Preciso de uma ajuda de vocês aqui do fórum.

Conheço um pouco de Excel, mas não sei nada de VBA nem de macros, e estou fazendo uma planilha aqui e vou precisar dar um Up com macros.

Peguei um código na internet que me ajuda parcialmente, e gostaria da ajuda da galera para fazer algumas adaptações.

 

Segue abaixo o que eu preciso.

Preciso fazer um backup de uma Aba para outra Aba com InputBox para renomear a nova Aba e jogar para o final.

Segue o código que achei, e até mudei, mas não obtive sucesso.

 

Sub Duplicar_e_Renomear()
    Sheets("Movimento do Dia").Copy After:=Sheets(ThisWorkbook.Worksheets.Count)
    Dim newSheet As Worksheet
    Set newSheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    newSheet.Name = InputBox("O nome do backup  é:", "Renomeando...", newSheet.Name)
    MsgBox "Backup Realizado com Sucesso!!!"
End Sub

Isso ele me copia a Aba inteira, e na verdade eu preciso copiar apenas um determinado Range, tipo "A1: E28".

Se puderem me ajudar com isso ficarei muito grato.

Me cadastrei agora no site, não sei nem se estou no lugar certo, mas é que estou com um pouco de urgência nessa planilha.

 

Desde já agradeço a todos.

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Fiz as alteracoes solicitadas. Veja se é isso:

 

Sub Duplicar_e_Renomear()
    Dim Rng As Range
    Dim newSheet As Worksheet
    Set Rng = Sheets("Movimento do Dia").Range("A1:E28")
    Set newSheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    Rng.Copy Destination:=newSheet.Range("A1")
    newSheet.Name = InputBox("O nome do backup  é:", "Renomeando...", newSheet.Name)
    MsgBox "Backup Realizado com Sucesso!!!"
End Sub

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Boa tarde Basole!

 

Na verdade esse código ele está substituindo  a Aba que eu tenho "Movimento do Dia", e eu preciso que ele crie em outra Aba uma cópia com o nome que eu incluir no inputbox.

 

Aproveitando, tem como eu colocar outras células no range? Tipo A1: E28, i1:o2?

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Bom pelo que entendi voce quer criar uma nova aba e copiar os intervalos citados da aba "Movimento do Dia", criando um  backup. 

Segue alteracao:

Sub Duplicar_e_Renomear()
    Dim Rng As Range
    Dim newName As String
    Dim newSheet As Worksheet
    
    With ThisWorkbook
    
    Set newSheet = .Sheets.Add(After:= _
                   .Sheets(.Sheets.Count))
    With .Sheets("Movimento do Dia")
    Set Rng = .Range(.Cells(1, 1), .Cells(28, 5))
    Rng.Copy Destination:=newSheet.Range("A1")
    Set Rng = .Range(.Cells(1, 9), .Cells(2, 15))
    Rng.Copy Destination:=newSheet.Range("I1")
    On Error GoTo Erro
    newName = InputBox("O nome do backup  é:", "Renomeando...", newSheet.Name)
    newSheet.Name = newName
    End With
    End With
        
    MsgBox "Backup Realizado com Sucesso!!!", 64, Sucesso
    Exit Sub
Erro: MsgBox Err.Description, 16
 On Error GoTo 0
End Sub

 

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Bom dia Basole!

 

Desculpe a demora.

Cara é exatamente isso que eu precisava, muito obrigado.

Eu já poderia até encerrar o post, mas vou fazer a última pergunta, se é possível ou não, mas de qualquer forma já me ajudou muito.

Tem como nesse código ele copiar a formatação do Range? Tipo assim, ele traz todos os dados da maneira que eu preciso, porém na nova Aba o tamanho das colunas são padrão do excel, e eu tenho que aumentar manualmente para visualizar as informações, e gostaria de saber se consegue copiar o mesmo tamanho das colunas, e uma que está oculta também, ou seja, ele copia o mesmo padrão.

 

Se for possível ótimo, mas se não der não tem problema, já me ajudou muito mesmo.

Obrigado.

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Tem sim. 

 

Segue o codigo completo, com as alteracoes solicitadas... 

 

Sub Duplicar_e_Renomear()
    Dim Rng As Range
    Dim newName As String
    Dim newSheet As Worksheet
    
    With ThisWorkbook
    
    Set newSheet = .Sheets.Add(After:= _
                   .Sheets(.Sheets.Count))
    With .Sheets("Movimento do Dia")
    
    Set Rng = .Range(.Cells(1, 1), .Cells(28, 5))
    Rng.Copy
    With newSheet.Range("A1")
    .PasteSpecial Paste:=xlPasteAll
    .PasteSpecial Paste:=xlPasteColumnWidths
    End With
    
    Set Rng = .Range(.Cells(1, 9), .Cells(2, 15))
    Rng.Copy
    With newSheet.Range("I1")
    .PasteSpecial Paste:=xlPasteAll
    .PasteSpecial Paste:=xlPasteColumnWidths
    End With
    
    Excel.Application.CutCopyMode = False
    
    On Error GoTo Erro
    newName = InputBox("O nome do backup  é:", "Renomeando...", newSheet.Name)
    newSheet.Name = newName
    End With
    End With
        
    MsgBox "Backup Realizado com Sucesso!!!", 64, Sucesso
    Exit Sub
Erro: MsgBox Err.Description, 16
 On Error GoTo 0
End Sub

 

  • Curtir 2

Compartilhar este post


Link para o post
Compartilhar em outros sites

Boa noite Basole!

 

Obrigado pela ajuda.

Vou encerrar o tópico.

Em 02/07/2019 às 11:46, Basole disse:

Tem sim. 

 

Segue o codigo completo, com as alteracoes solicitadas... 

 


Sub Duplicar_e_Renomear()
    Dim Rng As Range
    Dim newName As String
    Dim newSheet As Worksheet
    
    With ThisWorkbook
    
    Set newSheet = .Sheets.Add(After:= _
                   .Sheets(.Sheets.Count))
    With .Sheets("Movimento do Dia")
    
    Set Rng = .Range(.Cells(1, 1), .Cells(28, 5))
    Rng.Copy
    With newSheet.Range("A1")
    .PasteSpecial Paste:=xlPasteAll
    .PasteSpecial Paste:=xlPasteColumnWidths
    End With
    
    Set Rng = .Range(.Cells(1, 9), .Cells(2, 15))
    Rng.Copy
    With newSheet.Range("I1")
    .PasteSpecial Paste:=xlPasteAll
    .PasteSpecial Paste:=xlPasteColumnWidths
    End With
    
    Excel.Application.CutCopyMode = False
    
    On Error GoTo Erro
    newName = InputBox("O nome do backup  é:", "Renomeando...", newSheet.Name)
    newSheet.Name = newName
    End With
    End With
        
    MsgBox "Backup Realizado com Sucesso!!!", 64, Sucesso
    Exit Sub
Erro: MsgBox Err.Description, 16
 On Error GoTo 0
End Sub

 

 

  • Curtir 1

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

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

×
×
  • Criar novo...

GRÁTIS: minicurso “Como ganhar dinheiro montando computadores”

Gabriel TorresGabriel Torres, fundador e editor executivo do Clube do Hardware, acaba de lançar um minicurso totalmente gratuito: "Como ganhar dinheiro montando computadores".

Você aprenderá sobre o quanto pode ganhar, como cobrar, como lidar com a concorrência, como se tornar um profissional altamente qualificado e muito mais!

Inscreva-se agora!