Multiple criteria for moving a row to new spreadsheet

D

Dagonini

I'm trying to make a macro that will look at various columns then copy
a row to a new spreadsheet based on the criteria.

I need to look at column X, AA, AB, AC, AD

If there is a value in X, AC, AD the row needs to copy to spreadsheet1
If there is a value in AA, AB the row needs to copy to spreadsheet2

Some rows might have a value in all fields so would need to be copied
to both spreadsheets.

I keep trying to do a simple if, then but I'm stymied on how to get it
to look at multiple criteria. For example if a value is filled in for
all the fields I don't want it to copy to a new spreadsheet multiple
times, I just want it to copy once.

I started going in this direction:

Dim eelife As Integer

eelife = Range("x1").Value

Select Case eelife

Case Is > 0

but that is where I would get stuck because I don't want it to just
look at column X.

Does any one have any suggestions?
 
R

RyanH

I will assume your "Master Sheet" is Sheet1. The LastRow variables will scan
down Col.A and find the last cell with data and then return that row number.
If Col.X, AC, & AD have something in them then that entire row will be copied
to Sheet2, if Col.AA & AB both have something in them then the entire row
will be copied to Sheet3.

Sub CopyRows()

Dim i As Long
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim LastRow3 As Long

Application.ScreenUpdating = False

'finds the last cell in Sheet1 Col. A with data and returns the row #
LastRow1 = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

'finds the last cell in Sheet2 Col. A with data and returns the row #
LastRow2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row

'finds the last cell in Sheet3 Col. A with data and returns the row #
LastRow3 = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To LastRow1

If IsEmpty(Cells(i, 24)) = False And _
IsEmpty(Cells(i, 29)) = False And _
IsEmpty(Cells(i, 30)) = False Then

Cells(i, 1).EntireRow.Copy
Destination:=Worksheets("Sheet2").Rows(LastRow2 + 1)
LastRow2 = LastRow2 + 1
End If

If IsEmpty(Cells(i, 27)) = False And _
IsEmpty(Cells(i, 28))= False Then

Cells(i, 1).EntireRow.Copy
Destination:=Worksheets("Sheet3").Rows(LastRow3 + 1)
LastRow3 = LastRow3 + 1
End If

Next i

Application.ScreenUpdating = True

End Sub

Hope this helps!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top