VBA copy highlighted rows to another sheet

[M4TVD]

I am trying to copy the rows that are highlighted in one sheet into another sheet, the rows that I want to copy are filled yellow.

I have some code already, that will copy only the highlighted rows, however it copies the rows that are not highlighted (but copies them without any values in). I want to only copy the rows with data and ignore the blank rows.

this is the code that I have:

Sub CopyToBuildOutput()
 
Dim ws As Worksheet, MainWs As Worksheet, cell As Range
Set MainWs = Sheets("Build Output")



For Each ws In Sheets(Array("sheet1")) 
   If ws.Name <> MainWs.Name Then
      For Each cell In ws.UsedRange
          If cell.Interior.Color = vbYellow Then cell.Copy MainWs.Range(cell.Address)
         'If cell.DisplayFormat.Interior.Color = vbYellow Then MainWs.Range(cell.Address) = cell.Value
      Next
   End If
Next
    
End Sub

 

[Rick Rothstein]

For any single row that is highlighted, is the entire row colored yellow or only certain cells within that row?

 

[M4TVD]

only certain cells within the row (A:M) are highlighted yellow.

 

[Rick Rothstein]

I think this might do what you want...

Sub CopyToBuildOutput()
 
  Dim ws As Worksheet, MainWs As Worksheet, Cell As Range
  Set MainWs = Sheets("Build Output")

  For Each ws In Sheets(Array("sheet1"))
    If ws.Name <> MainWs.Name Then
      For Each Cell In ws.UsedRange.Columns(1).Cells
        If Cell(1).Interior.Color = vbYellow Then Cell.Copy MainWs.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 13)
      Next
    End If
  Next
    
End Sub

 

[M4TVD]

Hi Rick.

Your code does not work, it only copies one single row (and only the fill colour and not any of the cell contents)

 

[Rick Rothstein]

It worked for me in my tests on a dummy-upped sheet. Any chance you can post a copy of your workbook (desensitize any sensitive data) to DropBox so we can download it and see exactly what your data looks like?

 

[M4TVD]

unfortunately that is not soo easy for me to do as the document is HUGE with many sheets that are linked.

 

[Rick Rothstein]

I just noticed that the output I thought was correct from my original code was, in fact, not correct. Give this adjust code a try...

Sub CopyToBuildOutput()
 
  Dim ws As Worksheet, MainWs As Worksheet, Cell As Range
  Set MainWs = Sheets("Build Output")

  For Each ws In Sheets(Array("sheet1"))
    If ws.Name <> MainWs.Name Then
      For Each Cell In ws.UsedRange.Columns(1).Cells
        If Cell(1).Interior.Color = vbYellow Then Cell.Resize(, 13).Copy MainWs.Cells(Rows.Count, "A").End(xlUp).Offset(1)
      Next
    End If
  Next
    
End Sub

 

[M4TVD]

your corrected code now copies the cell data, but it is only copying the first of the rows that is highlighted yellow and not copying all of the rows that are yellow.

 

[Rick Rothstein]

but it is only copying the first of the rows that is highlighted yellow and not copying all of the rows that are yellow

That is puzzling to me because in my test (on a dummy-upped sheet), it copies all of the yellow rows without skipping any of them. So... I am not sure what to tell you. Hopefully, someone will come along with a guess as to what might be interfering with my code working on your data.