Ir ao conteúdo
  • Cadastre-se

Excel 2007 -Macro criar aba e copiar linha


proeletrica

Posts recomendados

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?

Link para o comentário
Compartilhar em outros sites

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

Link para o comentário
Compartilhar em outros sites

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

Link para o comentário
Compartilhar em outros sites

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.

Link para o comentário
Compartilhar em outros sites

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?

Link para o comentário
Compartilhar em outros sites

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

Link para o comentário
Compartilhar em outros sites

Visitante
Este tópico está impedido de receber novos posts.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades 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...

Curso de Redes MikroTik

LANÇAMENTO!

CLIQUE AQUI PARA SE INSCREVER!

* Este curso não é ministrado pela equipe do Clube do Hardware.