Notifications
Clear all

Passar linha pra outra planilha

9 Posts
2 Usuários
0 Reactions
1,802 Visualizações
(@xxxlsxx)
Posts: 42
Trusted Member
Topic starter
 

boa noite a todos.

tenho um arquivo com algumas planilhas.

Na planilha sorteio, vai sortear um funcionário que está na planilha dados.

E tenho 2 planilhas :

Funcionários 1 e Funcionários 2.

Quero que, ao clicar no botão Passar, ele copie a LINHA em que está o funcionário sorteado da planilha funcionários 1 pra planilha funcionários 2, só que depois tem que apagar a linha que copiei na planilha 1.

Porém, quero que essa linha seja passada para a primeira linha vazia da outra planilha, e, o campo código das duas planilhas sejam automaticamente atualizadas.

Por exemplo, se eu copiar o primeiro funcionário, os códigos da lista tem que ser atualizados automaticamente em ordem.

será que deu pra entender?

 
Postado : 18/09/2012 4:41 pm
(@lovera)
Posts: 90
Estimable Member
 

Ai mano, segue o codigo que vc precisa. Cola em um modulo da macro e atribui a macro no botão passar da planilha 1.
Só que tem umas coisinhas q vc precisa pensar antes.

Primeiro na planilha sorteio nem sempre o nome sorteado está na planilha funcionarios 1. Então eu imagino que o anexo seja só um exemplo. Porque se não esse teu esquema de sorteio já tá furado.

Segundo. O numero que aparece na celula C1 da planilha Sorteio tambem não está relacionada com coisa alguma.

Terceiro. O nome está numa celula que está mesclada na planilha Sorteio. Celulas mescladas sempre são uma zica pro VBA entender. Então na celula D1 eu igualei ela a celula D3 que vc mesclou. Faça o mesmo no seu arquivo senão essa macro não vai funcionar porque ela armazena em uma variavel o nome sorteado e atraves desse nome sorteado ela vai até a planilha funcionarios 1 localiza o nome armazena nas variaveis, apaga a linha inteira, cola na planilha funcionarios 2 volta para a funcionarios1 renumera a coluna A e o mesmo na coluna da Planilha funcionarios 2.

Quarto. Repense no lugar onde o seu botão está na planilha funcionarios 1 jogue ele lá para cima onde ele não atrapalhe o andamento da coluna por inteiro. A medida que essa planilha for alimentada ele vai estar lá enchendo o saco.

Segue o codigo. E seja feliz. Se funcionar aperta o botão agradecimento ai!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Sub BotaoPlan1()

Dim NovaMatr As Integer
Dim Matr As Integer
Dim linha1 As Integer
Dim linha2 As Integer
Dim linha3 As Integer
Dim MatrPlan1 As Integer
Dim FuncBusc As String
Dim Codigo1 As String, Func As String, Crit1 As String, Crit2 As String, Crit3 As String, Crit4 As String, Crit5 As String, Crit6 As String
Dim total1 As Integer
Dim total2 As Integer

FuncBusc = Sheets("Sorteio").Range("D3").Value 'pega a matricula q foi sorteada na planilha sorteio na celula C1
linha1 = 2 'na planilha funcionarios 1 as informações começam a partir da linha 2

Sheets("Funcionarios 1").Activate 'volta para a planilha funcionarios1

Laco1:
Func = Cells(linha1, 2).Value 'matrplan1 recebe o valor da linha da vez, só que da coluna 1
If FuncBusc <> Func Then 'comparando os valores dessas duas variaves sendo diferente ativa o looping
linha1 = linha1 + 1
GoTo Laco1 'e vai para a linha do laco1 para começar a comparação de novo
Else 'caso contrario
Codigo1 = Cells(linha1, 1).Value 'armazena na variavel a linha da coluna 1
Func = Cells(linha1, 2).Value 'idem só que da coluna 2
Crit1 = Cells(linha1, 3).Value '3
Crit2 = Cells(linha1, 4).Value '4
Crit3 = Cells(linha1, 5).Value 'e assim por diante
Crit4 = Cells(linha1, 6).Value
Crit5 = Cells(linha1, 7).Value
Crit6 = Cells(linha1, 8).Value
Cells(linha1, 1).Select 'ativando a celula da linha pertecente
ActiveCell.EntireRow.Delete 'uma vez ativada a celula selecionar a linha toda e deleta-la

Sheets("Funcionarios2").Activate 'ativando a planilha funcionarios2
Range("A1").Select
ActiveCell.End(xlDown).Activate 'uma vez selecionado a celula A1 vai para baixo até a ultima celula preenchida
ActiveCell.Offset(1, 0).Select 'dai desce mais uma linha que vai ser a primeira vazia
linha2 = ActiveCell.Row 'descobre o numero da linha e armazena nessa variavel linha2
Cells(linha2, 1).Value = Codigo1 'a linha da coluna 1 recebe a varivel codigo1
Cells(linha2, 2).Value = Func 'idem só que na coluna 2 recebendo a variavel fun
Cells(linha2, 3).Value = Crit1 'idem só que na coluna 3 recebendo a variavel crit1
Cells(linha2, 4).Value = Crit2 'o mesmo raciocionio
Cells(linha2, 5).Value = Crit3
Cells(linha2, 6).Value = Crit4
Cells(linha2, 7).Value = Crit5
Cells(linha2, 8).Value = Crit6
End If 'termina o if

Sheets("Funcionarios 1").Activate 'agora a gente volta pra planilha funcionarios 1
total1 = Application.WorksheetFunction.CountA(Range("A:A")) - 1 'descobrimos quanta linhas temos preenchidas so que restamos 1 porque ele vai contar o titulo da planilha que não serve para nada

linha3 = 2 'essa vai ser a linha de apoio, podiamos usar a variavel da linha2 mas para ficar mais seguro e não precisar ficar limpando nada jogamos mais uma variavel

For x = 1 To total1 Step 1 'iniciamos o looping pelo metodo for next que vai fazer o x ir até o numero do total1 somando 1 a cada rodada
NovaMatr = NovaMatr + 1 'ele vai somar mais um numero a cada looping
Cells(linha3, 1).Value = NovaMatr 'vai jogar a variavel na linha da vez com a variavel NovaMatr
linha3 = linha3 + 1 'soma mais um numero para a proxima linha do looping
Next

Sheets("Funcionarios2").Activate 'agora vamos pra proxima planilha
total2 = Application.WorksheetFunction.CountA(Range("A:A")) - 1 'numero total de linhas preenchidas menos o numero da linha de titulo
Range("A1").Activate 'ativando a celula A1
ActiveCell.End(xlDown).Activate 'descendo até a ultima preenchida
ActiveCell.Value = total2 'jogando nela o valor da variavel total2

End Sub

 
Postado : 18/09/2012 6:13 pm
(@xxxlsxx)
Posts: 42
Trusted Member
Topic starter
 

Muito obrigado, Lovera.

Mas quando fui testar o código, acusou um erro "Estouro".

 
Postado : 18/09/2012 6:35 pm
(@lovera)
Posts: 90
Estimable Member
 

Vc se certificou que o nome que foi sorteado está na lista da planilha funcionarios1?

Por exemplo testei agora e deu o nome Adailton na planilha sorteio.
Só que o nome Adailton não está na planilha de funcionarios 1. Então dá estouro. Segue o codigo com o tratamento de erro e se o nome não estiver lá ele vai aparecer para você em uma caixa de mensagens. Guenta ai!!!!

 
Postado : 18/09/2012 6:43 pm
(@lovera)
Posts: 90
Estimable Member
 

Sub BotaoPlan1()

On Error GoTo Tratamento

Dim NovaMatr As Integer
Dim Matr As Integer
Dim linha1 As Integer
Dim linha2 As Integer
Dim linha3 As Integer
Dim MatrPlan1 As Integer
Dim FuncBusc As String
Dim Codigo1 As String, Func As String, Crit1 As String, Crit2 As String, Crit3 As String, Crit4 As String, Crit5 As String, Crit6 As String
Dim total1 As Integer
Dim total2 As Integer

FuncBusc = Sheets("Sorteio").Range("D3").Value 'pega a matricula q foi sorteada na planilha sorteio na celula C1
linha1 = 2 'na planilha funcionarios 1 as informações começam a partir da linha 2

Sheets("Funcionarios 1").Activate 'volta para a planilha funcionarios1

Laco1:
Func = Cells(linha1, 2).Value 'matrplan1 recebe o valor da linha da vez, só que da coluna 1
If FuncBusc <> Func Then 'comparando os valores dessas duas variaves sendo diferente ativa o looping
linha1 = linha1 + 1
GoTo Laco1 'e vai para a linha do laco1 para começar a comparação de novo
Else 'caso contrario
Codigo1 = Cells(linha1, 1).Value 'armazena na variavel a linha da coluna 1
Func = Cells(linha1, 2).Value 'idem só que da coluna 2
Crit1 = Cells(linha1, 3).Value '3
Crit2 = Cells(linha1, 4).Value '4
Crit3 = Cells(linha1, 5).Value 'e assim por diante
Crit4 = Cells(linha1, 6).Value
Crit5 = Cells(linha1, 7).Value
Crit6 = Cells(linha1, 8).Value
Cells(linha1, 1).Select 'ativando a celula da linha pertecente
ActiveCell.EntireRow.Delete 'uma vez ativada a celula selecionar a linha toda e deleta-la

Sheets("Funcionarios2").Activate 'ativando a planilha funcionarios2
Range("A1").Select
ActiveCell.End(xlDown).Activate 'uma vez selecionado a celula A1 vai para baixo até a ultima celula preenchida
ActiveCell.Offset(1, 0).Select 'dai desce mais uma linha que vai ser a primeira vazia
linha2 = ActiveCell.Row 'descobre o numero da linha e armazena nessa variavel linha2
Cells(linha2, 1).Value = Codigo1 'a linha da coluna 1 recebe a varivel codigo1
Cells(linha2, 2).Value = Func 'idem só que na coluna 2 recebendo a variavel fun
Cells(linha2, 3).Value = Crit1 'idem só que na coluna 3 recebendo a variavel crit1
Cells(linha2, 4).Value = Crit2 'o mesmo raciocionio
Cells(linha2, 5).Value = Crit3
Cells(linha2, 6).Value = Crit4
Cells(linha2, 7).Value = Crit5
Cells(linha2, 8).Value = Crit6
End If 'termina o if

Sheets("Funcionarios 1").Activate 'agora a gente volta pra planilha funcionarios 1
total1 = Application.WorksheetFunction.CountA(Range("A:A")) - 1 'descobrimos quanta linhas temos preenchidas so que restamos 1 porque ele vai contar o titulo da planilha que não serve para nada

linha3 = 2 'essa vai ser a linha de apoio, podiamos usar a variavel da linha2 mas para ficar mais seguro e não precisar ficar limpando nada jogamos mais uma variavel

For x = 1 To total1 Step 1 'iniciamos o looping pelo metodo for next que vai fazer o x ir até o numero do total1 somando 1 a cada rodada
NovaMatr = NovaMatr + 1 'ele vai somar mais um numero a cada looping
Cells(linha3, 1).Value = NovaMatr 'vai jogar a variavel na linha da vez com a variavel NovaMatr
linha3 = linha3 + 1 'soma mais um numero para a proxima linha do looping
Next

Sheets("Funcionarios2").Activate 'agora vamos pra proxima planilha
total2 = Application.WorksheetFunction.CountA(Range("A:A")) - 1 'numero total de linhas preenchidas menos o numero da linha de titulo
Range("A1").Activate 'ativando a celula A1
ActiveCell.End(xlDown).Activate 'descendo até a ultima preenchida
ActiveCell.Value = total2 'jogando nela o valor da variavel total2

Exit Sub
Tratamento:
MsgBox "O nome sorteado " & FuncBusc & " não está na lista da planilha FUNCIONARIOS 1"
End Sub

 
Postado : 18/09/2012 6:46 pm
(@xxxlsxx)
Posts: 42
Trusted Member
Topic starter
 

Digitei o valor na célula lá e o nome sumiu da planilha, mas não foi pra outra.

Testei com Rodrigo, Reginaldo e não funcionou.

 
Postado : 18/09/2012 6:54 pm
(@lovera)
Posts: 90
Estimable Member
 

hm...

Lembre-se que não pode alterar os nomes das planilhas senão a macro não funciona mais. E tinha que igualar o nome na celula da planilha Sorteio.
Estou enviando o arquivo com as mudanças e comigo funfou de boa.

Testa ai.

 
Postado : 18/09/2012 7:02 pm
(@xxxlsxx)
Posts: 42
Trusted Member
Topic starter
 

Muito obrigado, Lovera.

Agora funcionou.

O problema vai ser pra eu aprender esse código, mas de boa. kkk

 
Postado : 18/09/2012 7:25 pm
(@lovera)
Posts: 90
Estimable Member
 

Eu coloquei os comentarios em verde. Uma dica para vc entender.
Coloque a janela do vba lado a lado com a janela do excel.
Aperte o F8 que ele vai depurando linha por linha. Isso vai te permitir entender como é o funcionamento dos looping.
Coloque o mouse sobre as variaveis que foram declaradas que a medida q o codigo anda os valores atribuidos mudam. Ou então deixe a janela de inspeção de variaveis aberta que ela vai te mostrando como elas mudam. Ela fica no menu exibir.

Qq duvida tamos ai.

Seje feliz!

 
Postado : 18/09/2012 7:32 pm