Como configuro uma macro onde ela executará as seguintes ações toda vez

Question

Sou um completo novato aqui e estou preso a uma tarefa que tenho que repetir nos próximos dias. Eu apreciaria muito sua gentil ajuda. Muito obrigado antecipadamente.

Configuração:

• Existem 2 folhas.
• Na Planilha1, há vários dados.
• Na Planilha2, há uma tabela de dados com o mesmo formato da planilha1, mas a tabela está vazia.

Ações desejadas:

1. Ir para a primeira linha da tabela de dados na Folha1.
2. Se o valor da coluna mais à direita dessa linha for "1", copie a linha inteira. Se não, vá para a próxima linha e verifique novamente. Repita isso até que algo seja copiado.
3. Vá para a primeira linha vazia da tabela de dados na Planilha2. Colar valores do que acabou de ser copiado.
4. Volte para 1. mas comece de onde você parou. Repita tudo até que todos os dados com a condição mencionada na Folha1 tenham sido copiados para a Folha2.

Progresso:

O script de macro gravado que recebi quando tentei imitar o acima.

SubMacro7()''Macro7Macro'Range("E11:R11").Select
Selection.Copy Sheets("v4 r2").Select
Range("E11").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("E12").Select Sheets("v4 q2").Select
Range("E12:R12").Select Application.CutCopyMode = False
Selection.Copy Sheets("v4 r2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("E13").Select
End Sub

    

Answer 1

Tente isso - tentei manter sua macro gravada, mas tendo em mente que queremos Evite usar .Select / .Activate e use uma variável ou duas para acompanhar a próxima linha vazia.

Sub t()
Dim lastCol&, lastRow&, emptyRow&, i&
Dim mainWS As Worksheet, copyToWS As Worksheet

' Create two variables to hold the sheets
Set mainWS = Sheets("v4 q2")
Set copyToWS = Sheets("v4 r2")

emptyRow = 1

'Now, let's find the last column in the mainWS, and last row
lastCol = mainWS.Cells(1, mainWS.Columns.Count).End(xlToLeft).Column
lastRow = mainWS.Cells(mainWS.Rows.Count, 1).End(xlUp).Row ' assuming your column A (1) has the most data

' Now, loop through your last Column, looking for '1'
For i = 1 To lastRow
    If mainWS.Cells(i, lastCol).Value = "1" Then
       ' Since you only want the VALUES, we can just set the two ranges equal to eachother
       ' instead of using .Copy
       copyToWS.Range(copyToWS.Rows(emptyRow), copyToWS.Rows(emptyRow)).Value = mainWS.Range(mainWS.Rows(i), mainWS.Rows(i)).Value
    emptyRow = emptyRow + 1
    End If
Next i

End Sub

Além disso, observe que, como você queria apenas os valores, podemos definir os intervalos como iguais, em vez de copiar / colar (o que usa a área de transferência e pode levar mais tempo). Para fazer isso, é apenas Range[destination].Value = Range[the range to copy].Value .