Jump to content
Fórum Script Brasil
  • 0

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


maza

Question

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 to comment
Share on other sites

5 answers to this question

Recommended Posts

  • 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 to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



  • Forum Statistics

    • Total Topics
      152.1k
    • Total Posts
      652k
×
×
  • Create New...