Excel Macro para copiar linhas selecionadas

[ljbrito]

Olá pessoal, boa tarde.

 

Precisaria de uma macro e envio a planilha teste para ajudar na visualização do problema.

 

Na aba "Marcar", você escolhe a turma pela célula A3 e na coluna C, marca com um x os alunos que você quer selecionar. Depois de selecionar, você clicaria no botão "Enviar alunos selecionados" e o nº e nome do aluno selecionado seria copiado para a planilha "Selecionado", juntamente com a turma "célula A3". Automaticamente ao apertar o botão, limparia os campos da coluna C, e assim que eu escolhesse outra turma (célula A3) para selecionar outros alunos, a coluna C estaria sem nenhum x e o processo se repetiria. Iria colocar x nos alunos que eu quisesse, apertaria o botão da macro e ele preencheria a planilha "Selecionado" de onde ele terminou de preencher a última vez e, claro, limparia os campos da coluna C novamente.

 

Espero não ser muito complexo. Me ajudaria bastante. Se alguém tiver uma ideia de um processo melhor que esse que no final dê o mesmo resultado, agradeço as sugestões também.

Lista Alunos Exemplo.xlsx

[Visitante]

Experimente:

 

opção1 - coloque "x" na coluna C (conforme explicado no seu post acima) e rode o código abaixo

Sub ReplicaDadosComX()
 Dim a As Long, c As Long
  Application.ScreenUpdating = False
  With ActiveSheet
   .AutoFilterMode = False
   .[A5:C5].AutoFilter 3, "x"
   .Range("A6:B" & .Cells(Rows.Count, 1).End(3).Row).Copy
   Sheets("Selecionado").Cells(Rows.Count, 1).End(3)(2).PasteSpecial xlValues
   a = Sheets("Selecionado").Cells(Rows.Count, 1).End(3).Row
   c = Sheets("Selecionado").Cells(Rows.Count, 3).End(3).Row
   Sheets("Selecionado").Cells(Rows.Count, 3).End(3)(2).Resize(a - c).Value = .[A3]
   .AutoFilterMode = False
   '.[C6:C41] = ""
   Application.CutCopyMode = False
   Application.ScreenUpdating = True
  End With
End Sub

 

opção2 - selecione os nomes na coluna B e rode o código abaixo (os "x" na coluna C não serão considerados)

dica para selecionar vários nomes ~~~> mantenha Ctrl pressionada enquanto seleciona os nomes com o mouse

Sub ReplicaSelecionados()
 Dim a As Long, c As Long, v As Range
  Application.ScreenUpdating = False
  For Each v In Selection
   If Not Intersect(v, [B6:B41]) Is Nothing And v.Value <> "" Then
    Cells(v.Row, 1).Resize(, 2).Copy
    Sheets("Selecionado").Cells(Rows.Count, 1).End(3)(2).PasteSpecial xlValues
    a = a + 1
   End If
  Next v
   If a > 0 Then
    Sheets("Selecionado").Cells(Rows.Count, 3).End(3)(2).Resize(a).Value = [A3]
   End If
   Application.CutCopyMode = False
   Application.ScreenUpdating = True
End Sub

obs. antes de testar os códigos acima limpe o intervalo A43:A59 da planilha Selecionado

[ljbrito]

@osvaldomp muito obrigado, as 2 formas funcionaram perfeitamente. Me salvou. Quando for para eu usar, logicamente usarei a sua sugestão, muito mais simples e eficiente, mas para um usuário na escola, conhecendo bem o povo, sei que a opção com x (visual) sem ficar segurando tecla, vai dar menos problemas (rs).

 

Nesse caso, não tem como apagar o x da coluna C depois do envio mesmo? 

 

MAis uma vez obrigado pela ajuda e solução, Osvaldo. 

[Visitante]

7 minutos atrás, ljbrito disse:

Nesse caso, não tem como apagar o x da coluna C depois do envio mesmo?

 

Desculpe, falha minha. Eu desativei o comando para testar e não o reativei.

 

Nesta linha do primeiro código ~~~> '.[C6:C41] = "" remova o apóstrofo inicial, destacado em vermelho.