Как настроить макрос, где он будет выполнять следующие действия каждый раз

Question

Я здесь новичок и застрял с заданием, которое я должен повторить в течение следующих нескольких дней. Я был бы очень признателен за вашу помощь. Большое спасибо заранее.

Настроить:

• Есть 2 листа.
• На Листе 1 есть куча данных.
• На Листе 2 есть таблица данных того же формата, что и на листе 1, но таблица пуста.

,

Желаемые действия:

1. Перейти к первой строке таблицы данных в Sheet1.
2. Если значение самого правого столбца этой строки равно "1", скопируйте всю строку. Если нет, перейдите к следующему ряду и проверьте еще раз. Повторяйте это, пока что-то не будет скопировано.
3. Перейти к первой пустой строке таблицы данных в Sheet2. Вставьте значения только что скопированного.
4. Вернитесь к 1. но начните с того места, где вы остановились. Повторяйте все это, пока все данные с указанным условием на листе 1 не будут скопированы на лист 2.

Прогресс:

Записанный скрипт макросов, который я получил, когда пытался имитировать вышеописанное.

---

Sub Macro7()                 ' ' Macro7 Macro '

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

Попробуйте это - я пытался придерживаться вашего записанного макроса, но помня, что мы хотим избежать использования .Select/.Activate и используйте переменную или две, чтобы отслеживать следующую пустую строку.

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

Кроме того, обратите внимание, что, поскольку вам нужны только значения, мы можем просто установить равные диапазоны вместо копирования / вставки (который использует буфер обмена и может занять больше времени). Чтобы сделать это, это просто Range[destination].Value = Range[the range to copy].Value