VBA Copy Paste into new worksheet, If statement and transpose

Question

I copy rows from Column E1:F1 when Column D equals to "Y". Pasting in transpose format in Sheet2. Looping until the end of Column D of Sheet1. When I edit the code to paste into G12 (as opposed to A1) it pastes values over each other instead of going down to the next blank cell in Column G.

I don't know where the code is wrong. Please help!

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

First, you should read [this answer](https://stackoverflow.com/a/10717999/4717755) on how to avoid using `Select` and `Activate` -- they are absolutely not necessary in your case (in almost all cases). Second, you can fix your problem by replacing the `12` with `rowg` in `S2.Cells(12, 7).Select` to make it `S2.Cells(rowg, 7).Select` — PeterT, Apr 29 '20 at 21:58

score 0 · Answer 1 · answered Apr 29 '20 at 22:38

How I would go about doing this:

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

Samuel Everson · Accepted Answer · 2020-04-29T23:20:00.297

To elaborate on Avoid using Select.

Using methods like Select, Copy and Paste are easy to read and visualise what your code is doing - but - it comes at a cost. It's not the most efficient performing code which can really show once your applications start getting bigger and bigger.

Big or small, it's a good practice to avoid these kinds of methods and refer directly to your Worksheet object and relevant Range on the worksheet to find data and put it somewhere else.

To paraphrase the top answers on that question, here are the main reasons to avoid these methods;

Select and Selection are a common cause for run-time errors.

This is because it relies on nothing (either code or the user) changing the sheets focus, If someone clicks somewhere else or something in your code changes the sheet or selection, it ~~can~~ will cause funky results or an error.

As mentioned above, they slow your code down. With a bit of googling you'll find tests performed showing the differences in time between using these methods and avoiding them.

with that said, this should resolve your issue:

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

I've made use of an array to grab the required column E to F values and transpose those to your destination range. I've used the rowg variable that you are updating with each iteration when the data is moved - because you had hardcoded 12 as the row, it was previously overwriting your values each time rather than moving to the next blank row.

Here are snips of sample sheet1 and sheet2 data:

Sheet1

Sheet2:

LIFE SAVER. thank you!! this worked! I added a 2nd criteria from your example it would look like this.. For r2 = 2 To lastrow If S1.Range("E" & r).Value = "E2" or S1.Range("E" & r).Value = "E20" or S1.range("E" & r).value = "E10 then .... transpose. doing this did not work, it seemed to repeat itself 4x. — B.Win, May 14 '20 at 14:58
@B.Win easiest way to debug that would be create some data where you know what the results should be, and step through the code, watching how the loop is assigning the values. Then adjust the logic once you work out where it's going wrong. — Samuel Everson, May 14 '20 at 22:29

VBA Copy Paste into new worksheet, If statement and transpose

2 Answers2

Sheet1

Sheet2: