Copy and paste to next empty row in another sheet and transpose - based on colour

SleightOfHand

New Member
Joined
Jun 19, 2020
Messages
17
Office Version
  1. 365
Platform
  1. Windows
Hi,

I'm almost there trying to copy and paste but I can't seem to find the right solution.

I've got a column that starts from E7 and goes to E100. It contains a few different inputs, but also has many yellow cells that I want to paste into another sheet. This sheet would need to be on the next available ROW that doesn't have data starting from the first cell of that row. This would be that I can edit those yellow cells and log them into another sheet. Lastly, the data would need to be transposed. What I've got at the moment:

VBA Code:
Sub Copy()
Dim Data as Range
     For Each Data in Sheets("No1").Range("E2:E100")
     If Data.interior.Color = RGB(255, 255, 183) Then
     Data.Copy

    Sheets("Out").Range("A" & Rows.Count).End(xlUp).Offset(1,0).PasteSpecial Paste:=xlPasteValues
End If

Next Data
End Sub

Adding transpose:= true doesn't seem to work.

Another thing is that this code just freezes up the sheets themselves although it does copy what I want.

Cheers!
 
Last edited by a moderator:

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
This code is expected to do what you want ...
VBA Code:
Sub Copy()
    Dim Data As Range, arr As Variant, n As Long
    ReDim arr(0, 0)
    For Each Data In Sheets("No1").Range("E2:E100")
        If Data.Interior.Color = RGB(255, 255, 183) Then
            ReDim Preserve arr(0, n)
            arr(0, n) = Data
            n = n + 1
        End If
    Next Data
    Set Data = Sheets("Out").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, UBound(arr, 2) + 1)
    Data.Value = arr
End Sub
 
Solution

Some videos you may like

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
You are welcome & thanks for letting me know.
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,438
Office Version
  1. 2013
Platform
  1. Windows
Try this:
VBA Code:
Sub Copy_Range_If_Yellow()
'Modified  12/16/2020  8:20:40 PM  EST
Application.ScreenUpdating = False
Dim r As Range
Dim i As Long
i = 1

For Each r In Sheets("No1").Range("E2:E100")
    If r.Interior.Color = RGB(255, 255, 183) Then r.Copy Sheets("Out").Cells(i, 1): i = i + 1
Next
Application.ScreenUpdating = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,127,656
Messages
5,626,133
Members
416,164
Latest member
Zhevr

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top