Este fórum está sendo desativado

[SandroLima]

Boa tarde, pessoal

Tenho o seguinte código que duplica a aba de uma planilha e renomeia:

Código: Selecionar todos

Sub DuplicaAbaeRenomeia()
    
    Application.ScreenUpdating = False

    ActiveSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    
    Dim NovaPlan As Worksheet
    
    Set NovaPlan = ActiveSheet
        
    With NovaPlan

        .Name = UCase(Sheets("RELATÓRIO MENSAL").Range("MesReferencia_RelMensal").Value)
    
    End With
    
    On Error GoTo 0
    
    Set NovaPlan = Nothing
    
    Exit Sub
    
    Application.ScreenUpdating = True
    
End Sub

Precisa implementá-lo de duas maneiras para testar:

1) Fixar/Colar todos os valores da nova aba que vão de A1:Py, onde "y" seria a última linha que apresenta conteúdo na Coluna B da nova aba;

e também quero testar ela funcionando da seguinte maneira

2) Fixar/Colar somente os valores das colunas Lx:Py, onde "x" seria a linha inicial onde começa o conteúdo da coluna L e onde "y" seria a última linha que apresenta conteúdo na Coluna B da nova aba.

A segunda opção pode ficar na forma comentada no código para que eu testar.

Obrigado a quem puder ajudar.

[Jimmy]

Sandro,

Quando diz que precisa "Fixar/Colar" está querendo dizer que quer que os valores deixem de ser fórmulas e passam a ser valores mesmo?

Jimmy

[SandroLima]

Bom dia, fórum... bom dia, Jimmy.

Quando diz que precisa "Fixar/Colar" está querendo dizer que quer que os valores deixem de ser fórmulas e passam a ser valores mesmo?

Exatamente.

[Jimmy]

Sandro, bom dia.

Teste isto:

Código: Selecionar todos

Sub DuplicaAbaeRenomeia()
    
    Application.ScreenUpdating = False

    ActiveSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    
    Dim NovaPlan As Worksheet
    
    Set NovaPlan = ActiveSheet
        
    NovaPlan.Name = UCase(Sheets("RELATÓRIO MENSAL").Range("MesReferencia_RelMensal").Value)
    
    'Inicio da parte nova
    Opcao = "A"        'Opção A = A1:Py, onde "y" seria a última linha que apresenta conteúdo na Coluna B
                       'Opção B = Lx:Py, onde "x" seria a linha inicial onde começa o conteúdo da coluna L e onde "y" seria a última linha que apresenta conteúdo na Coluna B da nova aba
    If Opcao = "A" Then
        LinFim = Range("B" & Rows.Count).End(xlUp).Row
        Destin = "A1"
        Origem = Destin & ":L" & LinFim
    Else
        If Range("L1").Value <> "" Then
            LinIni = 1
        Else
            LinIni = Range("L1").End(xlDown).Row
            If LinIni = Rows.Count Then MsgBox "Nada encontrado na coluna L.": GoTo Pula
        End If
        LinFim = Range("B" & Rows.Count).End(xlUp).Row
        Destin = "L" & LinIni
        Origem = Destin & ":P" & LinFim
    End If
    Range(Origem).Copy
    Range(Destin).PasteSpecial Paste:=xlPasteValues
    Range("A1").Select
Pula:
    'Fim da parte nova
    
    Application.CutCopyMode = False
    
    Set NovaPlan = Nothing
   
    Application.ScreenUpdating = True
    
End Sub

Jimmy San Juan

[babdallas]

Veja se ajuda.

Código: Selecionar todos

Public Sub DuplicaAbaeRenomeia()
    Const lngPriLin     As Long = 2         'Linha inicial (ajustar conforme a sua necessidade)
    'Se houver alguma regra para obter a primeira linha, avise. Na linha acima eu coloquei com constante
    
    Dim lngUltLin       As Long             'ùltima linha preenchida
    Dim NovaPlan        As Worksheet        'Nova Planilha
    
    Application.ScreenUpdating = False
    
    
    With ActiveSheet
        lngUltLin = .Cells(.Rows.Count, 2).End(xlUp).Row        'Obter a última linha preenchida da coluna B
        .Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copia a planilha p/ a última posição
    End With

    Set NovaPlan = ActiveSheet
       
    With NovaPlan
        .Range("L1:P" & lngUltLin).Value = .Range("L1:P" & lngUltLin).Value     'Copia só valores
        '.Range("L" & lngPriLin & ":P" & lngUltLin).Value = .Range("L1:P" & lngUltLin).Value     'Copia só valores
        .Name = UCase(Sheets("RELATÓRIO MENSAL").Range("MesReferencia_RelMensal").Value)
   
    End With
   
    On Error GoTo 0
   
    Set NovaPlan = Nothing
   
    Application.ScreenUpdating = True
   
End Sub

[SandroLima]

Bom dia, usuários do fórum.

Bom dia, Jimmy. Bom dia, babdallas.

Fiz uma mescla do código de vcs e funcionou perfeitamente atingindo o resultado pretendido.

Ficou assim:

Código: Selecionar todos

Sub DuplicaAbaeRenomeia()
    
    Application.ScreenUpdating = False

    ActiveSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    
    Dim NovaPlan As Worksheet
    Dim PriLin As Long, UltLin As Long
    
    Set NovaPlan = ActiveSheet
        
    With NovaPlan
        .Name = UCase(Sheets("RELATÓRIO MENSAL").Range("MesReferencia_RelMensal").Value)
        PriLin = Range("L1").End(xlDown).Row                'Obter a primeira linha preenchida da coluna L
        UltLin = .Cells(.Rows.Count, 2).End(xlUp).Row       'Obter a última linha preenchida da coluna B
        .Range("L" & PriLin & ":P" & UltLin).Copy
        .Range("L" & PriLin & ":P" & UltLin).PasteSpecial Paste:=xlPasteValues
        .Range("A1").Select
    End With
    
    Application.CutCopyMode = False

    On Error GoTo 0
    
    Set NovaPlan = Nothing
    
    Exit Sub
    
    Application.ScreenUpdating = True
    
End Sub

Se virem algum erro ou algo desnecessário por favor podem comentar.

Muito obrigado a vcs... tenham um final de semana abençoado.