Ir para conteúdo
Fórum Script Brasil
  • 0

Rodar a macro para todas as linhas da planilha (loop)


maza

Pergunta

Boa tarde a todos,

 

Gostaria muito da ajuda, pois não encontrei nas minhas pesquisas para resolver meu problema.

Tenho uma planilha que ela tem mais de mil linhas, basicamente a macro que gravei é simples: ela pega a primeira linha, cola em outra planilha, copia os valores, depois volta pra planilha inicial compia a segunda linha e cola na outra planilha e copia valores.

No entanto, é inviável eu gravar a macro para todas as linhas, por isso quero criar um loop que reproduza a mesma gravação para todas as linhas da planilha até encontrar uma linha vazia, que acaba o loop.

Alguém consegue me ajudar inserindo o loop nos códigos??

Sub teste()
'
' teste Macro
'

'
    Range("A4:O4").Select
    Selection.Copy
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Planilha3").Select
    Range("A2").Select
    ActiveSheet.Paste
    Range("P2:T2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Planilha2").Select
    Range("A5:O5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Planilha3").Select
    Range("A3").Select
    ActiveSheet.Paste
    Range("P3:T3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub
 

Link para o comentário
Compartilhar em outros sites

5 respostass a esta questão

Posts Recomendados

  • 0

Veja se este lhe atende:

Sub Transferir()
Application.ScreenUpdating = False
If ActiveCell.Value = "" Then
MsgBox "Selecione uma celula preenchida", vbExclamation, "AVISO"
Exit Sub
End If

Sheets("Plan2").Select
Range("A1").Select
Sheets("Plan1").Select


Do
ActiveCell.Select
    Selection.Copy
    Sheets("Plan2").Select
    
    Do
    If ActiveCell.Value <> "" Then
    ActiveCell.Offset(1, 0).Select
    End If
    Loop Until ActiveCell.Value = ""
    
    ActiveCell.Select
    ActiveSheet.Paste
    
    Sheets("Plan1").Select
    ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Value = ""

MsgBox "Todas as celulas copiadas", vbInformation, "IMPORTANTE"

Application.ScreenUpdating = True
End Sub

Ele funciona assim:

1º Selecione a 1º célula que deseja copiar (No caso aqui: Plan1).

2º Ele vai na planilha destino (Plan2) e seleciona A1 como referencia para colar.

3º Volta para a planilha 1 e copiar a primeira celular.

4º Vai até a planilha de destino e verifica se a célula inicial (A1) contém dados, se houve ira selecionar imediatamente a debaixo, e se esta também conter dados ira repetir o processo até encontrar uma célula vazia.

5º Volta a planilha 1 e seleciona uma célula abaixo da última copiada e repete o processo.

6º Ela irá rodar até que não hajam mais dados na planilha 1.

 

 

Você pode colocar referencias para serem digitadas antes de iniciar o macro como o inputbox, como: Planilha 1 e planilha de destino, celular inicial para copiar e para colar e etc.

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...