Excel 2007 -Macro criar aba e copiar linha

[proeletrica]

Boa tarde colegas

Tenho uma planilha chamada programação de montagem, para controle da evolução de serviços que está no link .http://www.sendspace.com/file/hdx44n

Gostaria que a cada código lançado na coluna C (beneficiament.) da planilha programação de montagem , uma macro criase uma nova aba com este código e copiase toda esta linha onde está o código para desta nova aba. Caso o código lançado já tenha uma aba, a macro não criará uma aba repetida e sim só copiará a linha para dentro da aba existente deste código. A medida que os serviços vão sendo executados(vencidas a datas de entrega) , eu vou apagando manualmente da planilha programação de montagem , mas não deverão serem apagadas de dentro de suas abas.

Alguem pode me dar uma dica , de como posso fazer isto?

[Visitante]

1. faça uma cópia de qualquer uma das planilhas (clique na guia com o direito, 'Mover ou copiar...', 'Criar uma cópia', OK); se preferir arraste a guia dessa cópia feita para a última posição à direita; ainda na cópia, delete as células a partir da linha 6 para baixo, de A até G, deixando somente as fórmulas na coluna H; nomeie essa cópia de 'Modelo' . A planilha 'Modelo' será usada para criar novas planilhas.

2. cole o código abaixo no módulo da planilha 'PROGRAMAÇÃO DE MONTAGEM' : clique com o direito na guia dessa planilha, escolha 'Exibir Código', cole o código na janela em branco que se abrirá

3. Alt+F11 para retornar para a planilha e fazer os testes

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 3 Or Target.Count > 1 _
Or Target.Value = "" Then Exit Sub
Dim plan As Worksheet, flg As Boolean
Dim nomePlan As String, LR As Long
nomePlan = Target.Value
Application.ScreenUpdating = False
    For Each plan In Worksheets
        If plan.Name Like nomePlan Then flg = True: Exit For
    Next
        If flg = True Then
            With Sheets(plan.Name)
                LR = .Cells(Rows.Count, 3).End(xlUp).Row
                Cells(Target.Row, 1).Resize(, 7).Copy
                .Cells(LR + 1, 1).PasteSpecial
            End With
        Else
            Sheets("Modelo").Copy after:=Sheets(1)
            With ActiveSheet
                .Name = nomePlan
                Cells(Target.Row, 1).Resize(, 7).Copy
                .Cells(6, 1).PasteSpecial
            End With
        End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

[proeletrica]

Bom dia Oswaldomp

Obrigado pelo rápido retorno, vou testar mais tarde e depois retornarei.

[proeletrica]

Boa tarde oswaldomp

A planilha do novo codigo está sendo preenchida até a coluna "C" (inclusive), deverá tambem preencher as colunas "D" ,"E", "F" e "G".

Após eu digitar o codigo na coluna "C" na planilha programação de montagem, a macro está me levando para a nova planilha, isto não deverá acontecer , pois tenho terminar de digitar nos campos restantes.

Na verdade a macro não precisa me levar para a nova planilha, é necessario somente copiar toda a linha onde foi digitado o codigo na coluna "C". Se ajudar posso alterar a posição da coluna do código para a ultima coluna.

Nem sei se estou sendo claro. Qualquer dúvida , Grita

[Visitante]

A planilha do novo codigo está sendo preenchida até a coluna "C" (inclusive), deverá tambem preencher as colunas "D" ,"E", "F" e "G".

A macro copia e cola de A até G. Como provavelmente você testou começando a inserir dados pela A, depois B, ao preencher a C a macro disparou, então de D até G estava em branco, por isso na planilha destino as células D:G ficaram vazias. Teste preenchendo a coluna C por último.

Na verdade a macro não precisa me levar para a nova planilha, é necessario somente copiar toda a linha onde foi digitado o codigo na coluna "C". Se ajudar posso alterar a posição da coluna do código para a ultima coluna.

É isso que o código faz, cola a linha na planilha existente, ou em uma nova planilha, se o caso.

A macro dispara ao prencher a coluna C. Se quiser podemos alterar para disparar por botão. Ou, por exemplo, disparar ao prenncher G, e só executar o copiar/colar se C estiver preenchido, ou só copiar/colar se estiverem preenchidas todas as células de A até G.

Diga como você quer disparar a macro e quais células checar e faremos os ajustes.

[proeletrica]

Oswaldomp

O que está acontecendo é exatamente o que tú postaste.Podemos disparar a macro quando estiverem preenchidas todas as celulas de A até G.

È possivel inserir na macro a ordenação das abas para facilitar a localização dos códigos?

No momento que excluo uma linha da planilha programação de montagem, abre uma janela MVB, dizendo ERRO EM TEMPO DE EXECUÇÂO '13' , TIPOS INCOMPATÌVEIS e também aparece 3 botões FIM ,DEPURAR , AJUDA.Então aperto o botão FIM e a linha é excluída . Tá normal isto?

[Visitante]

1. o código só executa se todas as células de A até G estiverem preenchidas, em uma mesma linha, não importando a ordem de preenchimento

2. deixe a guia da planilha 'PROGRAMAÇÃO DE MONTAGEM' na primeira posição, à esquerda, e a 'Modelo, na última. Estas duas planilhas não serão incluídas na ordenação.

3. não mais ocorre erro ao excluir linha

4. substitua o código anterior por este

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Y As Range, LR As Long
Dim plan As Worksheet, flg As Boolean
Dim nomePlan As String, i, j As Integer
    If Target.Column > 7 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
Set Y = Range(Cells(Target.Row, 1), Cells(Target.Row, 7))
If Application.WorksheetFunction.CountA(Y) < 7 Then Exit Sub
nomePlan = Cells(Target.Row, 3).Value
Application.ScreenUpdating = False
    For Each plan In Worksheets
        If plan.Name Like nomePlan Then flg = True: Exit For
    Next
        If flg = True Then
            With Sheets(plan.Name)
                LR = .Cells(Rows.Count, 3).End(xlUp).Row
                Cells(Target.Row, 1).Resize(, 7).Copy
                .Cells(LR + 1, 1).PasteSpecial
            End With
        Else
            Sheets("Modelo").Copy After:=Sheets(1)
            With ActiveSheet
                .Name = nomePlan
                Cells(Target.Row, 1).Resize(, 7).Copy
                .Cells(6, 1).PasteSpecial
            End With
    For i = 2 To Sheets.Count - 1
      For j = 2 To Sheets.Count - 2
        If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
            Sheets(j).Move After:=Sheets(j + 1)
        End If
      Next j
    Next i
        End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheets(1).Activate
End Sub

[proeletrica]

Osvaldomp

Muito obrigado, funcionou tudo bem.

Tú é o verdadeiro ninja neste tal de Excel.

Um fraterno abraço, do tamanho do do RIO GRANDE DO SUL

Que DEUS continue te iluminando.

Moderador pode fechar o tópico

[Visitante]

Bah, tchê...

fico contente por teres resolvido a tua parada

outro abraço, fique na paz

[Flavio Soares]

Caso o autor do tópico necessite, o mesmo será reaberto, para isso deverá entrar em contato com a moderação solicitando o desbloqueio.