Solved: Copy rows from one worksheet to another with some condition.

[megha]

I want to copy rows from one worksheet to another with some condition.

I have six worksheets with same format (i.e. 8 Columns, its headings and etc.) and each worksheet is for different section (i.e. Section A, Section B, Section C, etc.). Now what I want is whenever cells “E,” “F,” and “G” of the row from any six worksheets is empty I want to have that entire row to copy to the 7th worksheet called “Summary.” Can someone please help me with the VBA? I don’t have the code for it. Thanks!

[RolfJ]

Let's first be clear on what you mean by 'worksheet'. Do you mean six separate workbooks (formerly referred to as 'worksheets') or six separate worksheets (or tabs) in a single workbook?

[megha]

It is six separate worksheets (or tabs) in a single workbook. Everything is in one single workbook, even the 7th sheet (called, 'Summary') also in the same workbook.

Thanks.

[RolfJ]

As long as you have now other worksheets in your workbbook the following code should do the trick for any number of worksheets, regardless of their names. Please note that this macro only copies those rows that are not already present in the 'Summary' worksheet:



Const MONITOR_COLUMN_1 As String = "E"
Const MONITOR_COLUMN_2 As String = "F"
Const MONITOR_COLUMN_3 As String = "G"
Const SUMMMARY_WORKSHEET As String = "Summary"

Sub ConsolidateRowsWithMissingCells()
Dim shSummary As Worksheet
Set shSummary = Worksheets(SUMMMARY_WORKSHEET)
Dim sh As Worksheet
For Each sh In Worksheets
If sh.Name <> SUMMMARY_WORKSHEET Then
Dim db As Range
Set db = sh.UsedRange
Dim rRow As Range
For Each rRow In db.Rows
If rRow.Cells(1, MONITOR_COLUMN_1).Value = "" _
And rRow.Cells(1, MONITOR_COLUMN_2).Value = "" _
And rRow.Cells(1, MONITOR_COLUMN_3).Value = "" _
Then
If Not DataExists(shSummary, rRow) Then
rRow.Copy Destination:=shSummary.Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
End If
Next rRow
End If
Next sh
End Sub

Function DataExists(sh As Worksheet, r As Range) As Boolean
'This function assumes that the Range r is a single row
Dim db As Range
Set db = sh.UsedRange
Dim rRow As Range
Dim dataIdentical As Boolean
For Each rRow In db.Rows
dataIdentical = True
Dim iCol As Integer
For iCol = 1 To r.Columns.Count
If rRow.Cells(1, iCol) <> r.Cells(1, iCol) Then
dataIdentical = False
Exit For
End If
Next iCol
If dataIdentical Then
DataExists = True
Exit Function
End If
Next rRow
DataExists = False
End Function

[megha]

Hey Rolfj… thank you sooooooooo much. Amazing….!!! It works. I had search a lot for this, but didn’t know that you will be the solution.

Thank you so much..!!!