Excel Copiar Range com Inputbox no Excel

[Etoruiz]

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.

 

[Basole]

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

 

[Etoruiz]

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?

 

[Basole]

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

 

 

[Etoruiz]

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.

[Basole]

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

 

[Etoruiz]

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