Results 1 to 3 of 3
  1. #1
    New Lounger
    Join Date
    May 2003
    Location
    48150
    Posts
    6
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Macro to copy row based on color

    I am in need of help with VBA code that will copy all rows where cells in column A is red and then paste the entire row into a new worksheet.

    This one is above my pay grade.

    Can anyone help?

    JG

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    The following will look at the cells in col A of the activeworksheet and copy them to the same row in a new worksheet:

    Code:
    Option Explicit
    Sub CopyRedRowsAsIs()
      Dim wks As Worksheet
      Dim wNew As Worksheet
      Dim lRow As Long
      Dim x As Long
      
      Set wks = ActiveSheet
      lRow = wks.Cells.SpecialCells(xlCellTypeLastCell).Row
      Set wNew = Worksheets.Add
      For x = 1 To lRow
        If wks.Cells(x, 1).Interior.Color = vbRed Then
          wks.Cells(x, 1).EntireRow.Copy wNew.Cells(x, 1)
        End If
      Next
    End Sub
    If you want to not keep the same row as the original, but group them together in the new worksheet, the following code will do that

    Code:
    Option Explicit
    Sub CopyRedRowsGroup()
      Dim wks As Worksheet
      Dim wNew As Worksheet
      Dim lRow As Long
      Dim lNewRow As Long
      Dim x As Long
      
      Set wks = ActiveSheet
     lRow = wks.Cells.SpecialCells(xlCellTypeLastCell).Row
      Set wNew = Worksheets.Add
      lNewRow = 1
      For x = 1 To lRow
        If wks.Cells(x, 1).Interior.Color = vbRed Then
          wks.Cells(x, 1).EntireRow.Copy wNew.Cells(lNewRow, 1)
          lNewRow = lNewRow + 1
        End If
      Next
    End Sub
    If you want something different, you will have to be more specific...

    Steve
    Last edited by sdckapr; 2011-12-10 at 17:33.

  3. #3
    New Lounger
    Join Date
    Nov 2013
    Posts
    1
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by sdckapr View Post
    The following will look at the cells in col A of the activeworksheet and copy them to the same row in a new worksheet:

    Code:
    Option Explicit
    Sub CopyRedRowsAsIs()
      Dim wks As Worksheet
      Dim wNew As Worksheet
      Dim lRow As Long
      Dim x As Long
      
      Set wks = ActiveSheet
      lRow = wks.Cells.SpecialCells(xlCellTypeLastCell).Row
      Set wNew = Worksheets.Add
      For x = 1 To lRow
        If wks.Cells(x, 1).Interior.Color = vbRed Then
          wks.Cells(x, 1).EntireRow.Copy wNew.Cells(x, 1)
        End If
      Next
    End Sub
    If you want to not keep the same row as the original, but group them together in the new worksheet, the following code will do that

    Code:
    Option Explicit
    Sub CopyRedRowsGroup()
      Dim wks As Worksheet
      Dim wNew As Worksheet
      Dim lRow As Long
      Dim lNewRow As Long
      Dim x As Long
      
      Set wks = ActiveSheet
     lRow = wks.Cells.SpecialCells(xlCellTypeLastCell).Row
      Set wNew = Worksheets.Add
      lNewRow = 1
      For x = 1 To lRow
        If wks.Cells(x, 1).Interior.Color = vbRed Then
          wks.Cells(x, 1).EntireRow.Copy wNew.Cells(lNewRow, 1)
          lNewRow = lNewRow + 1
        End If
      Next
    End Sub
    If you want something different, you will have to be more specific...

    Steve

    This macro works well for my needs but I have tried to modify it in order to look for at more than one column but I have not been successful... How would I need to modify this macro (CopyRedRowsGroup) in order to look at column A to Z? Thank you in advance!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •