Este fórum está sendo desativado

[JoaoBento]

Viva,
Estou na minha primeira postagem e gostava de obter a vossa ajuda e ficarei muito agradecido.
O que é estranho é que a minha macro já funcionou noutro ficheiro, e parou de funcionar, a partir do momento que alterei o nome da planilha, apesar de eu ter corrigido essas alterações na macro.
Em suma, pretendo inserir o numero 1 numa coluna que detém uma série de dados (planilha EMI) e ao executar a macro, detecta a linha ou as linhas que têm esse numero 1, copia e cola em outra folha (planilha QTAS), numa linha vazia. Depois, Volta à folha EMI, apaga a linha que acabou de copiar e volta à folha Qtas e posiciona o cursor numa determinada célula.

Código: Selecionar todos

Sub Quotas()

Dim MyVar As Integer
Dim Em    As Worksheet
Dim Qt    As Worksheet
                
MyVar = Sheets("EMI").Range("M1").Value      

Set Em = Sheets("EMI")
Set Qt = Sheets("Qtas")

Em.Select                                             'selecciona o folha que quero começar a trabalhar
Em.Range("A18").Select               'coloca o cursor onde quero que se inicie a busca

 Do While ActiveCell.Value <> ""                                            
    
          If ActiveCell.Value = MyVar Then
          
                Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 13)).Copy                     'Selecciono o que quero copiar

                Qt.Select                                                                                                                                'Selecciono a folha para aonde quero copiar
                
                Range("A999").Select                                                                                                      'Vou ao fundo da tabela da coluna A
                Selection.End(xlUp).Select                                                                                          'Ando para cima
                ActiveCell.Offset(1, 0).Select                                                                                      'Desco uma linha
                                                              
                ActiveSheet.Paste
           
           
                Em.Select                                                        'Selecciono a folha onde quero apagar
                ActiveCell.EntireRow.Delete                  'Apago linha da célula activa
                MsgBox "Quota inserida!"                      'Envio de mensagem
                Exit Do
            
          End If

          
            ActiveCell.Offset(1, 0).Select       'Ando uma linha para baixo, evitando o loop eterno

            Loop

Qt.Select                                        'Selecciono a folha onde quero acabar
Range("A1").Select                    'Selecciono a célula onde quero por o cursor

End Sub

Anexo o arquivo
Muito obrigado pela vossa ajuda.
JoãoBento

[osvaldomp]

Olá, João.

Fiz pequenas alterações e aparentemente funciona bem. Experimente.

ativei
MyVar = 1

desativei
'Exit Do
'ActiveCell.Offset(1, 0).Select

Dicas - outras formas de executar essa tarefa (sem Loop):
1. utilize Find ... FindNext ou
2. utilize AutoFilter
3. não utilize Select nos seus códigos

[JoaoBento]

Muito obrigado pela sua resposta, Osvaldo,
Fiz o que sugeriu e funcionou a primeira vez, mas a depois deixa de funcionar de novo.
Já pesquisei e descobri que o problema do Select e alterei para o Activate, mas também não funciona.
Não sabia que era possível com a função do Find, mas vou estudar e perceber como adapto. Agora o AutoFilter, conheço, mas já percebi que às vezes dá problemas e por isso, não optei por esse caminho.
Entretanto peço-lhe o favor de testar mais do que uma vez e pergunto, será que o problema pode ser do meu computador, ou do excel, que tenha desligado alguma coisa?
Obrigado, uma vez mais.

[osvaldomp]

Olá, João.

Acabei de testar várias vezes e funciona sempre bem.

Podemos tentar simplificar o seu código e também não utilizar o Select (e tampouco Activate), pois estes comandos retardam a execução do código e limitam o seu desenvolvimento.

Se houver interesse informe:
1. porque os registros a serem transferidos para a Planilha2 estão a partir da linha 18, separados da tabela ?(vi na sua planilha que o registro que estão na linha 18 é duplicata da linha 10 (?)
2. a partir de A18 para baixo todos os registros terão o número 1 ? ou haverá números diferentes ou células vazias?
3. na planilha de exemplo, o seu objetivo real seria transferir o registro da linha 10?

[JoaoBento]

Olá Osvaldo,
Parece que coloquei um código e mandei um ficheiro diferente. As minhas desculpas.
Na verdade o que pretendia era colocar o cursor na linha 5 e não 18, pois esta foi uma cópia da 10, de quando andei a fazer testes.
A ideia é eu ter uma lista de todas as quotas do ano (sem espaços e linhas vazias) e à medida que chegamos aos meses, elas são transferidas para a planilha 2.
Claro que tenho interesse e até a agradeço a sua ajuda.
Entretanto andei a estudar o Find e percebo que é o melhor método, mas primeiro que eu consiga concretizar, vai ainda levar algum tempo, porque não sou assim tão experiente.
O que faço é ir estudando vídeos no YouTube e ir procurando adaptar as lições às minhas necessidades.
Muito obrigado

[osvaldomp]

Olá, João.

O que eu entendi até agora é que você deseja transferir alguns registros da planilha EMI para a planilha QTAS e que os registros a serem transferidos serão marcados manualmente com o número 1 na coluna A, é isso?
Se sim, então experimente o código abaixo. Utilizei o recurso AutoFiltro, que me parece mais adequado neste caso.
Se não, então explique, sff.

Código: Selecionar todos

Sub TransfereRegistros()
 Dim LR As Long
 With ActiveSheet
  .AutoFilterMode = False
  If Application.CountIf([A:A], 1) = 0 Then Exit Sub 'não executa se não houver ao menos um número 1 na coluna A
  LR = .Cells(Rows.Count, "B").End(xlUp).Row 'obtém o número da última linha com conteúdo na coluna B
  .Range("A5:L" & LR).AutoFilter 1, 1 'exibe somente os registros que contém o número 1 em A
  .Range("B5:L" & LR).Copy 'copia de [i]EMI [/i]
  Sheets("QTAS").Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlValues 'cola em [i]QTAS [/i]
  .Range("A5:A" & LR).EntireRow.Delete 'exclui as linhas correspondentes aos registros transferidos
  .AutoFilterMode = False
 End With
End Sub

dica - se você quiser acompanhar a execução passo a passo do código então ajuste o tamanho e a posição da janela do editor de VBA sobre a planilha EMI (esta ficará em segundo plano) de forma que você possa observar os efeitos de cada linha de comando do código na planilha, e rode o código via toques na tecla F8; para saber mais sobre qualquer comando do VBA posicione o cursor sobre ele e aperte F1.

[JoaoBento]

Viva Osvaldo,
Nem sei como lhe agradecer. Você me deu uma ajuda enorme, pois ando nisto há muito tempo.
Funcionou na perfeição e era tudo o que precisava. Percebi o funcionamento com o F8 e parece que tenho que fazer um pequeno ajuste, pois a linha a copiar é em duplicado, mas deixe que a partir daqui já consigo resolver.
Uma vez mais, muito, muito obrigado.
Bem haja!
Grande abraço,
João Bento

[osvaldomp]

... pois a linha a copiar é em duplicado ...

Viva, João.

Essa parte aí acima eu não entendi do que se trata.

Retorne se precisar de mais alguma ajuda.

[JoaoBento]

Viva Osvaldo,
O que me está a acontecer é que me faz a cópia do "intervalo dos critérios" do Find + o "intervalo da lista", isto é, a linha onde tenho o 1 e a linha que pertence à célula A5.
Deve ser simples de alterar, mas não estou a conseguir.
Muito obrigado uma vez mais.

[osvaldomp]

Olá, João.

Veja o arquivo anexado, sff.

É uma cópia do seu arquivo com o código instalado.

[JoaoBento]

Viva Osvaldo,
Baixei o arquivo e fiz, mas na verdade copia-me a linha que quero + a linha 5, isto é, a primeira de toda a lista.
A nota que você colocou acerca do raciocínio, está correctíssima.
Sugiro que desmarque a linha 5, fixe o nome e depois vai ver que também passa para a outra folha.
Abraço

[osvaldomp]

Viva, João.
Desculpe, falha minha.
O código está filtrando a partir da linha 5, porém o correto é a partir da linha 4.
Altere conforme em vermelho abaixo, no lugar do número 5 coloque o 4, sff.
.Range("A4:L" & LR).AutoFilter 1, 1 'exibe somente os registros que contém o número 1 em A

[JoaoBento]

Viva Osvaldo,
Continua a dar o mesmo problema, pois copia a linha 4 e na vez seguinte a linha 3...etc.
A verdade é que já tinha tentado.
Tenho tentado entender o seu código, mas estou com dificuldades, pois ainda não tinha visto nenhum exemplo a começar por pontos. Ex: .Range("A4:L" & LR).AutoFilter 1, 1
Pode me explicar um pouco?
Obrigado.

[osvaldomp]

Continua a dar o mesmo problema, pois copia a linha 4 e na vez seguinte a linha 3...etc.
Por acaso você alterou outras linhas no código além daquela que eu sugeri?

.Range("A4:L" & LR).AutoFilter 1, 1
Pode me explicar um pouco?
Veja abaixo.

Nos casos em que há múltiplas referências a um objeto, no seu caso, à planilha ativa, como abaixo,
ActiveSheet.AutoFilterMode = False
LR = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row 'obtém o número da última linha com conteúdo na coluna B
ActiveSheet.Range("A4:L" & LR).AutoFilter 1, 1 'exibe somente os registros que contém o número 1 em A
ActiveSheet.Range("B5:L" & LR).Copy 'copia de EMI
'...
'...

pode-se utilizar With objeto ... End With e com isso pode-se excluir todas as referências ao objeto situadas no interior do With...End With e aí restam os pontos, conforme abaixo.
With ActiveSheet
.AutoFilterMode = False
'...
'...
End With

[JoaoBento]

Agora eu entendi melhor o seu código.
Mas quanto à sua pergunta, claro que não. Para que eu não me pudesse enganar, baixei de novo o Excel que você publicou e fui alterar apenas a a sua sugestão.
Obrigado,

[JoaoBento]

Desculpe!
Fui fazer de novo e agora percebi que me enganei na linha.
Foi mesmo trapalhada minha.
Muito obrigado pela paciência e grande ajuda.
Abração