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