Td bem ,

depois se tiver um tempo se puder mim ajudar nessaquestao que expressei fico , grato .

Marciobin

A título de esclarecimento:

A mãozinha só serve para agradecer e não tranca o tópico.
Mesmo em tópicos de outros usuários, quando você encontrar uma resposta que foi útil para você, deve clicar na mãozinha para incentivar os colaboradores a continuarem ajudando, afinal, fazem isso de forma gratuita.

Quanto ao V (vezinho Verde), faça testes antes de clicar no vezinho, pois quando clicar, a moderação irá trancar o tópico.
Se por acaso, mesmo assim for necessário reabrir o tópico, basta enviar uma mensagem privada para um dos moderadores.

[]s

marcio, como as alterações na rotina serão simples não vou anexar o modelo novamente, é só acrescentar uma instrução, mas vou colocar as rotinas já com a alteração, procure acompanhar e faça conforme indicado abaixo :

Acrescentei somente a instrução - Application.EnableEvents, ela deve ser utilizado com cautela, pois a mesma desativa eventos ou impede a continuação de outras rotinas, ela é do tipo Boolean ou seja True / False.

1º ) Na aba JAN, troque por esta

'MACRO PARA COPIAR COLUNA , LEGAL
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("f8:f10000")) Is Nothing Then Exit Sub
        
'Impede que apos alterar a celula faça um loop
Application.EnableEvents = False
    
    If Target <> "" Then
        Cells(Target.Row, 7).Value = Target.Value
    Else
        Cells(Target.Row, 7).Value = ""
    End If
    
Application.EnableEvents = True

End Sub

2º ) Formulário INSERIR_LINHA
Botão "SIM" - troque por esta:

Private Sub inserirlinha_Click()
    Dim sLinAtiva  As Long
    Dim sRowOrigem, sRowDestino As Long

    'Selecione a linha antes de executar
    ActiveSheet.Unprotect
    
    'Armazena a linha selecionada
    sLinAtiva = Selection.Row
    
    'Verifica se estamos na linha 6 que é a primeira apos os rotulos
    'Define as variaveis de acordo com a linha selecionada
    If sLinAtiva = 7 Then
        sRowOrigem = 1
        sRowDestino = 0
    Else
        sRowOrigem = -1
        sRowDestino = 0
    End If

    Application.EnableEvents = False

        With Selection.EntireRow
            .Insert
            Selection.Offset(sRowOrigem, 5).Copy Destination:=Selection.Offset(sRowDestino, 5)
             ' Selection.Offset(sRowOrigem, 5).Copy Destination:=Selection.Offset(sRowDestino, 8)
               'Selection.Offset(sRowOrigem, 3).Copy Destination:=Selection.Offset(sRowDestino, 5)
               'Se for a linha 6 copiamos e colamos o formato
                If sLinAtiva = 7 Then
                    'Selection.Offset(1, 0).Resize(RowSize:=1, ColumnSize:=1).Copy
                   ' Selection.PasteSpecial xlPasteFormats
                    Application.CutCopyMode = False
                End If
        
        End With

    Unload Me
    
    ActiveSheet.Protect
    
    Application.EnableEvents = True
    
End Sub

3º ) Formulário confirmacaodeexclusaodelinhas
Botão "Confirmar Exclusão" - troque por esta:

Private Sub OK_Click()
    ActiveSheet.Unprotect
    
    If senha.Text = "" Then
        MsgBox "Digite Senha Correta Ou Cancele Operação", vbInformation, "Deus é Fiel !!!"
    ElseIf senha.Text = "123" Then
    
        MsgBox "Operação Realizada Com Sucesso !!!", vbInformation, "Planejamento Financeiro Mensal - Deus é Fiel !!! "
    
        Application.EnableEvents = False
        Selection.EntireRow.Delete
    
    'ocultar menus
    
    
        Unload Me
    ElseIf senha.Text <> "pfm2014" Then
        MsgBox "Senha Incorreta", vbInformation, "Deus é Fiel !!!"
        senha = ""
    
        Me.senha.SetFocus
    
    End If

    ActiveSheet.Protect
    
    Application.EnableEvents = True

End Sub

Faça os testes e veja se é isto.

[]s

Muito obrigado ,

exatamente isto , muito bom . que Deus possa conceder mais e mais sabedoria .

boa tarde .
obrigado !