Копировать VBA Вставить в новый лист, если заявление и транспонировать

Question

Я копирую строки из столбца E1: F1, когда столбец D равен «Y». Вставка в транспонированном формате в Sheet2. Цикл до конца столбца D листа 1. Когда я редактирую код для вставки в G12 (в отличие от A1), он вставляет значения друг в друга вместо перехода к следующей пустой ячейке в столбце G.

Я не знаю, где код неправильный , Пожалуйста помоги!

Sub CopyPaste3()

Dim row As Integer
Dim lastrow As Integer
Dim r As Integer
Dim S1 As Worksheet
Dim S2 As Worksheet


Set S1 = Worksheets("Sheet1")
Set S2 = Worksheets("sheet2")
row = 1
rowg = 12
lastrow = S1.Range("A" & Rows.Count).End(xlUp).row

For r = 2 To lastrow
    If S1.Range("D" & r).Value = "Y" Then
        S1.Range("E1:F1").Rows(r).Copy

        S2.Activate
        S2.Cells(12, 7).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        rowg = S2.Range("G" & Rows.Count).End(xlUp).row + 1
    End If
Next r
End Sub 

Answer 1

Для уточнения Избегайте использования Select .

Использование таких методов, как Select, Copy и Paste, легко читается и визуализирует то, что делает ваш код - но - это приходит за плату. Это не самый эффективный и эффективный код, который может действительно отображаться, когда ваши приложения начинают становиться все больше и больше.

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

Перефразируя главные ответы на этот вопрос, вот основные причины, по которым следует избегать этих методов;

• Выбор и выбор являются частой причиной ошибок во время выполнения.
  • Это потому, что он не полагается ни на что (ни код, ни пользователь), изменяющий фокус листов. Если кто-то щелкает где-то еще или что-то в вашем коде меняет лист или выделение, он может вызовет странные результаты или ошибку.
• Как уже упоминалось выше, они замедляют ваш код. Немного погуглив, вы найдете тесты, показывающие разницу во времени между использованием этих методов и их избеганием.

с учетом сказанного, это должно решить вашу проблему:

Sub CopyPaste3()

Dim row As Integer
Dim lastrow As Integer
Dim r As Integer
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim myArray As Variant
Dim Destination As Range

Set S1 = Worksheets("Sheet1")
Set S2 = Worksheets("sheet2")
rowg = 12
lastrow = S1.Range("A" & Rows.Count).End(xlUp).row


For r = 2 To lastrow
    If S1.Range("D" & r).Value = "Y" Then
        myArray = S1.Range("E" & r & ":F" & r).Value
        Set Destination = S2.Cells(rowg, 7)
        Set Destination = Destination.Resize(UBound(myArray, 2), 1)
        Destination = Application.Transpose(myArray)
        rowg = S2.Range("G" & Rows.Count).End(xlUp).row + 1
    End If
Next r
End Sub

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

Вот примеры данных листа1 и листа2:

Лист1

Лист2:

Answer 2

Как бы я go об этом:

Sub Shelter_In_Place()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim i As Long, lr1 As Long, lr2 As Long

lr1 = ws1.Range("D" & ws1.Rows.Count).End(xlUp).row
lr2 = ws2.Range("G" & ws2.Rows.Count).End(xlUp).row

For i = 2 To lr1
    If ws1.Range("D" & i) = "Y" Then

        ws1.Range("E" & i).Resize(1, 2).Copy
        ws2.Range("G" & lr).PasteSpecial xlPasteAll, Transpose:=True
        lr = lr + 2

    End If
Next i

End Sub