Solved

Copy rows based on value in cell to first available empty row.

Posted on 2012-03-15
4
309 Views
Last Modified: 2012-03-15
I have a spreadsheet with Columns A thru L.  I need to copy rows if the value in Column C is equal to Brown into the first empty cells at the end of the spreadsheet.
0
Comment
Question by:mato01
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
4 Comments
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 37727454
You can try this. You will have to assign appropriate sheet names to sws and tws
0
 
LVL 42

Expert Comment

by:dlmille
ID: 37727504
If you want to copy those rows to the bottom of the existing sheet, use the first sub copyRows().  Otherwise, if you want a new worksheet created and the rows with A:L data and C column is blank, then use the sub copyRowsNewWorksheet()

The app works on the active sheet of the active workbook.  Finds cells with blanks in column c then copys that row range A:L to the bottom of the worksheet, or appends to a new sheet, depending on routine selected.

Option Explicit

Sub copyRows()
Dim wkb As Workbook
Dim wks As Worksheet
Dim r As Range
Dim rng As Range
Dim lastRow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    Set wkb = ActiveWorkbook
    Set wks = wkb.ActiveSheet
    
    lastRow = wks.Range("A" & wks.Rows.Count).End(xlUp).Row
    Set rng = wks.Range("C1:C" & lastRow)
    For Each r In rng.SpecialCells(xlCellTypeBlanks)
        wks.Range("A" & r.Row & ":L" & r.Row).Copy 'copy A:L on blank cell column C to bottom of existing worksheet
        wks.Range("A" & lastRow + i + 1).PasteSpecial
        Application.CutCopyMode = False
        i = i + 1

    Next r
        
    MsgBox "Process Complete"
    
    Application.ScreenUpdating = True
End Sub
Sub copyRowsNewWorksheet()
Dim wkb As Workbook
Dim wks As Worksheet
Dim wksOut As Worksheet
Dim r As Range
Dim rng As Range
Dim lastRow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    Set wkb = ActiveWorkbook
    Set wks = wkb.ActiveSheet
    Set wksOut = wkb.Worksheets.Add(after:=wkb.Worksheets(wks.Name))
    
    lastRow = wks.Range("A" & wks.Rows.Count).End(xlUp).Row
    Set rng = wks.Range("C1:C" & lastRow)
    For Each r In rng.SpecialCells(xlCellTypeBlanks)
        wks.Range("A" & r.Row & ":L" & r.Row).Copy 'copy A:L on blank cell column C to bottom of existing worksheet
        wksOut.Range("A" & i + 1).PasteSpecial
        Application.CutCopyMode = False
        i = i + 1
    Next r
        
    MsgBox "Process Complete"
    
    Application.ScreenUpdating = True
End Sub

Open in new window


see attached demonstration workbook.

Dave
copyrows-r1.xls
0
 
LVL 43

Assisted Solution

by:Saqib Husain, Syed
Saqib Husain, Syed earned 250 total points
ID: 37727506
Oops...no macro attached

Sub a()
Dim lr As Long, cel As Range, tws As Worksheet, Sws As Worksheet
Set Sws = Sheets("Sheet3")
Set tws = Sheets("Sheet1")
lr = Sws.Cells.Find("*", Range("A1"), , , , xlPrevious).Row + 1
For Each cel In Sws.Range("C1:C" & lr)
If cel.Value = "Brown" Then
cel.Offset(0, -2).Resize(1, 12).Copy tws.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next cel
End Sub
0
 
LVL 42

Accepted Solution

by:
dlmille earned 250 total points
ID: 37727513
Looks like my post prompted you, and then yours prompted me!

not blank cells, cells having BROWN!

Here's my repost:
Option Explicit

Sub copyRows()
Dim wkb As Workbook
Dim wks As Worksheet
Dim r As Range
Dim rng As Range
Dim lastRow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    Set wkb = ActiveWorkbook
    Set wks = wkb.ActiveSheet
    
    lastRow = wks.Range("A" & wks.Rows.Count).End(xlUp).Row
    Set rng = wks.Range("C1:C" & lastRow)
    For Each r In rng
        If UCase(r.Value) = "BROWN" Then
            wks.Range("A" & r.Row & ":L" & r.Row).Copy 'copy A:L on blank cell column C to bottom of existing worksheet
            wks.Range("A" & lastRow + i + 1).PasteSpecial
            Application.CutCopyMode = False
            i = i + 1
        End If

    Next r
        
    MsgBox "Process Complete"
    
    Application.ScreenUpdating = True
End Sub
Sub copyRowsNewWorksheet()
Dim wkb As Workbook
Dim wks As Worksheet
Dim wksOut As Worksheet
Dim r As Range
Dim rng As Range
Dim lastRow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    Set wkb = ActiveWorkbook
    Set wks = wkb.ActiveSheet
    Set wksOut = wkb.Worksheets.Add(after:=wkb.Worksheets(wks.Name))
    
    lastRow = wks.Range("A" & wks.Rows.Count).End(xlUp).Row
    Set rng = wks.Range("C1:C" & lastRow)
    For Each r In rng
        If UCase(r.Value) = "BROWN" Then
            wks.Range("A" & r.Row & ":L" & r.Row).Copy 'copy A:L on blank cell column C to bottom of existing worksheet
            wksOut.Range("A" & i + 1).PasteSpecial
            Application.CutCopyMode = False
            i = i + 1
        End If
    Next r
        
    MsgBox "Process Complete"
    
    Application.ScreenUpdating = True
End Sub

Open in new window


Attached find demo.  Should be a collaborative effort, lol.

Dave
copyrows-r2.xls
0

Featured Post

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

690 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question