Hi,

Using Ron de Bruin's code below to copy range from worksheets to one master
sheet, how can I copy just those rows in each range from each page that do
not have a date in the "m" column? I need a summary of action items for
each person that haven't been completed yet. Is this possible?

Thanks in advance for any help.
Pam

Sub CopyRangeFromMultiWorksheets()

Dim sh As Worksheet

Dim DestSh As Worksheet

Dim Last As Long

Dim CopyRng As Range

With Application

..ScreenUpdating = False

..EnableEvents = False

End With

'Delete the sheet "RDBMergeSheet" if it exist

Application.DisplayAlerts = False

On Error Resume Next

ActiveWorkbook.Worksheets("RDBMergeSheet").Delete

On Error GoTo 0

Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"

Set DestSh = ActiveWorkbook.Worksheets.Add

DestSh.Name = "RDBMergeSheet"

'loop through all worksheets and copy the data to the DestSh

For Each sh In ActiveWorkbook.Worksheets

If sh.Name < DestSh.Name Then

'Find the last row with data on the DestSh

Last = LastRow(DestSh)

'Fill in the range that you want to copy

Set CopyRng = sh.Range("A1:G1")

'Test if there enough rows in the DestSh to copy all the data

If Last + CopyRng.Rows.Count DestSh.Rows.Count Then

MsgBox "There are not enough rows in the Destsh"

GoTo ExitTheSub

End If

'This example copies values/formats, if you only want to copy the

'values or want to copy everything look at the example below this macro

CopyRng.Copy

With DestSh.Cells(Last + 1, "A")

..PasteSpecial xlPasteValues

..PasteSpecial xlPasteFormats

Application.CutCopyMode = False

End With

'Optional: This will copy the sheet name in the H column

DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name

End If

Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet

DestSh.Columns.AutoFit

With Application

..ScreenUpdating = True

..EnableEvents = True

End With

End Sub

Hi Pam

You need to filter each sheet before you copy or filter the summery sheet when the merge
macro is ready and delete the rows you not want.

You say not a date
Date are just numbers so you have empty cells in M and cells with a number/Date
Am I correct ?

I will post a example this evening for you if you answer this

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Pam" wrote in message ...
Hi,

Using Ron de Bruin's code below to copy range from worksheets to one master
sheet, how can I copy just those rows in each range from each page that do
not have a date in the "m" column? I need a summary of action items for
each person that haven't been completed yet. Is this possible?

Thanks in advance for any help.
Pam

Sub CopyRangeFromMultiWorksheets()

Dim sh As Worksheet

Dim DestSh As Worksheet

Dim Last As Long

Dim CopyRng As Range

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

'Delete the sheet "RDBMergeSheet" if it exist

Application.DisplayAlerts = False

On Error Resume Next

ActiveWorkbook.Worksheets("RDBMergeSheet").Delete

On Error GoTo 0

Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"

Set DestSh = ActiveWorkbook.Worksheets.Add

DestSh.Name = "RDBMergeSheet"

'loop through all worksheets and copy the data to the DestSh

For Each sh In ActiveWorkbook.Worksheets

If sh.Name < DestSh.Name Then

'Find the last row with data on the DestSh

Last = LastRow(DestSh)

'Fill in the range that you want to copy

Set CopyRng = sh.Range("A1:G1")

'Test if there enough rows in the DestSh to copy all the data

If Last + CopyRng.Rows.Count DestSh.Rows.Count Then

MsgBox "There are not enough rows in the Destsh"

GoTo ExitTheSub

End If

'This example copies values/formats, if you only want to copy the

'values or want to copy everything look at the example below this macro

CopyRng.Copy

With DestSh.Cells(Last + 1, "A")

.PasteSpecial xlPasteValues

.PasteSpecial xlPasteFormats

Application.CutCopyMode = False

End With

'Optional: This will copy the sheet name in the H column

DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name

End If

Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet

DestSh.Columns.AutoFit

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub

Ron,

Thank you for replying - I think the codes you have supplied are great.
Thank you for your generosity.

My sheets are set up as such:

Month Action Due Completed
Nov Write Report 11/15/09 11/12/09
Nov Update Quote 11/20/09
Nov Call Customer 11/1/09 11/10/09

Hope you can read this and it's not scrambled.
I need the row where the completed date is empty so that on a summary sheet
I can tell what still needs to be accomplished at a quick glance.

Again, thanks for your help.
Pam

"Ron de Bruin" wrote in message
...
Hi Pam

You need to filter each sheet before you copy or filter the summery sheet
when the merge
macro is ready and delete the rows you not want.

You say not a date
Date are just numbers so you have empty cells in M and cells with a
number/Date
Am I correct ?

I will post a example this evening for you if you answer this

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Pam" wrote in message
...
Hi,

Using Ron de Bruin's code below to copy range from worksheets to one
master sheet, how can I copy just those rows in each range from each page
that do not have a date in the "m" column? I need a summary of action
items for each person that haven't been completed yet. Is this possible?

Thanks in advance for any help.
Pam

Sub CopyRangeFromMultiWorksheets()

Dim sh As Worksheet

Dim DestSh As Worksheet

Dim Last As Long

Dim CopyRng As Range

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

'Delete the sheet "RDBMergeSheet" if it exist

Application.DisplayAlerts = False

On Error Resume Next

ActiveWorkbook.Worksheets("RDBMergeSheet").Delete

On Error GoTo 0

Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"

Set DestSh = ActiveWorkbook.Worksheets.Add

DestSh.Name = "RDBMergeSheet"

'loop through all worksheets and copy the data to the DestSh

For Each sh In ActiveWorkbook.Worksheets

If sh.Name < DestSh.Name Then

'Find the last row with data on the DestSh

Last = LastRow(DestSh)

'Fill in the range that you want to copy

Set CopyRng = sh.Range("A1:G1")

'Test if there enough rows in the DestSh to copy all the data

If Last + CopyRng.Rows.Count DestSh.Rows.Count Then

MsgBox "There are not enough rows in the Destsh"

GoTo ExitTheSub

End If

'This example copies values/formats, if you only want to copy the

'values or want to copy everything look at the example below this macro

CopyRng.Copy

With DestSh.Cells(Last + 1, "A")

.PasteSpecial xlPasteValues

.PasteSpecial xlPasteFormats

Application.CutCopyMode = False

End With

'Optional: This will copy the sheet name in the H column

DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name

End If

Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet

DestSh.Columns.AutoFit

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub

If the RDBMerge sheet is ready and active you can run this macro that
filter on column M and delete all rows with a value in M

Sub Delete_with_Autofilter()
Dim DeleteValue As String
Dim rng As Range
Dim calcmode As Long

With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

DeleteValue = "0"

With ActiveSheet

'Firstly, remove the AutoFilter
.AutoFilterMode = False

'Apply the filter
.Range("M1").EntireRow.Insert
.Range("M1").Value = "Header"
.Range("M1:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=DeleteValue

With .AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With

'Remove the AutoFilter
.AutoFilterMode = False
.Range("M1").EntireRow.Delete
End With

With Application
.ScreenUpdating = True
.Calculation = calcmode
End With

End Sub


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Pam" wrote in message ...
Ron,

Thank you for replying - I think the codes you have supplied are great.
Thank you for your generosity.

My sheets are set up as such:

Month Action Due Completed
Nov Write Report 11/15/09 11/12/09
Nov Update Quote 11/20/09
Nov Call Customer 11/1/09 11/10/09

Hope you can read this and it's not scrambled.
I need the row where the completed date is empty so that on a summary sheet
I can tell what still needs to be accomplished at a quick glance.

Again, thanks for your help.
Pam

"Ron de Bruin" wrote in message
...
Hi Pam

You need to filter each sheet before you copy or filter the summery sheet
when the merge
macro is ready and delete the rows you not want.

You say not a date
Date are just numbers so you have empty cells in M and cells with a
number/Date
Am I correct ?

I will post a example this evening for you if you answer this

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Pam" wrote in message
...
Hi,

Using Ron de Bruin's code below to copy range from worksheets to one
master sheet, how can I copy just those rows in each range from each page
that do not have a date in the "m" column? I need a summary of action
items for each person that haven't been completed yet. Is this possible?

Thanks in advance for any help.
Pam

Sub CopyRangeFromMultiWorksheets()

Dim sh As Worksheet

Dim DestSh As Worksheet

Dim Last As Long

Dim CopyRng As Range

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

'Delete the sheet "RDBMergeSheet" if it exist

Application.DisplayAlerts = False

On Error Resume Next

ActiveWorkbook.Worksheets("RDBMergeSheet").Delete

On Error GoTo 0

Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"

Set DestSh = ActiveWorkbook.Worksheets.Add

DestSh.Name = "RDBMergeSheet"

'loop through all worksheets and copy the data to the DestSh

For Each sh In ActiveWorkbook.Worksheets

If sh.Name < DestSh.Name Then

'Find the last row with data on the DestSh

Last = LastRow(DestSh)

'Fill in the range that you want to copy

Set CopyRng = sh.Range("A1:G1")

'Test if there enough rows in the DestSh to copy all the data

If Last + CopyRng.Rows.Count DestSh.Rows.Count Then

MsgBox "There are not enough rows in the Destsh"

GoTo ExitTheSub

End If

'This example copies values/formats, if you only want to copy the

'values or want to copy everything look at the example below this macro

CopyRng.Copy

With DestSh.Cells(Last + 1, "A")

.PasteSpecial xlPasteValues

.PasteSpecial xlPasteFormats

Application.CutCopyMode = False

End With

'Optional: This will copy the sheet name in the H column

DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name

End If

Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet

DestSh.Columns.AutoFit

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub

Ron,

I can't seem to get the filter to work. I copied it to a module and when I
try running it the page blinks, but there are no error messages or anything
and I still have the same number of rows. I did notice one factor I left
out. I would like to keep the rows where column M (completed date) does not
have a date and column L (date due) does have a date. I've noticed in my
copy there are some totally blank lines copying over and I need for those to
delete because there is nothing in M, as well.

Can you please let me know what I'm doing wrong?

Thank you,
Pam

"Ron de Bruin" wrote:

If the RDBMerge sheet is ready and active you can run this macro that
filter on column M and delete all rows with a value in M

Sub Delete_with_Autofilter()
Dim DeleteValue As String
Dim rng As Range
Dim calcmode As Long

With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

DeleteValue = "0"

With ActiveSheet

'Firstly, remove the AutoFilter
.AutoFilterMode = False

'Apply the filter
.Range("M1").EntireRow.Insert
.Range("M1").Value = "Header"
.Range("M1:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=DeleteValue

With .AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With

'Remove the AutoFilter
.AutoFilterMode = False
.Range("M1").EntireRow.Delete
End With

With Application
.ScreenUpdating = True
.Calculation = calcmode
End With

End Sub


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Pam" wrote in message ...
Ron,

Thank you for replying - I think the codes you have supplied are great.
Thank you for your generosity.

My sheets are set up as such:

Month Action Due Completed
Nov Write Report 11/15/09 11/12/09
Nov Update Quote 11/20/09
Nov Call Customer 11/1/09 11/10/09

Hope you can read this and it's not scrambled.
I need the row where the completed date is empty so that on a summary sheet
I can tell what still needs to be accomplished at a quick glance.

Again, thanks for your help.
Pam

"Ron de Bruin" wrote in message
...
Hi Pam

You need to filter each sheet before you copy or filter the summery sheet
when the merge
macro is ready and delete the rows you not want.

You say not a date
Date are just numbers so you have empty cells in M and cells with a
number/Date
Am I correct ?

I will post a example this evening for you if you answer this

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Pam" wrote in message
...
Hi,

Using Ron de Bruin's code below to copy range from worksheets to one
master sheet, how can I copy just those rows in each range from each page
that do not have a date in the "m" column? I need a summary of action
items for each person that haven't been completed yet. Is this possible?

Thanks in advance for any help.
Pam

Sub CopyRangeFromMultiWorksheets()

Dim sh As Worksheet

Dim DestSh As Worksheet

Dim Last As Long

Dim CopyRng As Range

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

'Delete the sheet "RDBMergeSheet" if it exist

Application.DisplayAlerts = False

On Error Resume Next

ActiveWorkbook.Worksheets("RDBMergeSheet").Delete

On Error GoTo 0

Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"

Set DestSh = ActiveWorkbook.Worksheets.Add

DestSh.Name = "RDBMergeSheet"

'loop through all worksheets and copy the data to the DestSh

For Each sh In ActiveWorkbook.Worksheets

If sh.Name < DestSh.Name Then

'Find the last row with data on the DestSh

Last = LastRow(DestSh)

'Fill in the range that you want to copy

Set CopyRng = sh.Range("A1:G1")

'Test if there enough rows in the DestSh to copy all the data

If Last + CopyRng.Rows.Count DestSh.Rows.Count Then

MsgBox "There are not enough rows in the Destsh"

GoTo ExitTheSub

End If

'This example copies values/formats, if you only want to copy the

'values or want to copy everything look at the example below this macro

CopyRng.Copy

With DestSh.Cells(Last + 1, "A")

.PasteSpecial xlPasteValues

.PasteSpecial xlPasteFormats

Application.CutCopyMode = False

End With

'Optional: This will copy the sheet name in the H column

DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name

End If

Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet

DestSh.Columns.AutoFit

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub


.

Mmm


This line

..Range("M1:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=DeleteValue

must be

..Range("M1:M" & .Rows.Count).AutoFilter Field:=1, Criteria1:=DeleteValue



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"PHisaw" wrote in message ...
Ron,

I can't seem to get the filter to work. I copied it to a module and when I
try running it the page blinks, but there are no error messages or anything
and I still have the same number of rows. I did notice one factor I left
out. I would like to keep the rows where column M (completed date) does not
have a date and column L (date due) does have a date. I've noticed in my
copy there are some totally blank lines copying over and I need for those to
delete because there is nothing in M, as well.

Can you please let me know what I'm doing wrong?

Thank you,
Pam

"Ron de Bruin" wrote:

If the RDBMerge sheet is ready and active you can run this macro that
filter on column M and delete all rows with a value in M

Sub Delete_with_Autofilter()
Dim DeleteValue As String
Dim rng As Range
Dim calcmode As Long

With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

DeleteValue = "0"

With ActiveSheet

'Firstly, remove the AutoFilter
.AutoFilterMode = False

'Apply the filter
.Range("M1").EntireRow.Insert
.Range("M1").Value = "Header"
.Range("M1:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=DeleteValue

With .AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With

'Remove the AutoFilter
.AutoFilterMode = False
.Range("M1").EntireRow.Delete
End With

With Application
.ScreenUpdating = True
.Calculation = calcmode
End With

End Sub


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Pam" wrote in message ...
Ron,

Thank you for replying - I think the codes you have supplied are great.
Thank you for your generosity.

My sheets are set up as such:

Month Action Due Completed
Nov Write Report 11/15/09 11/12/09
Nov Update Quote 11/20/09
Nov Call Customer 11/1/09 11/10/09

Hope you can read this and it's not scrambled.
I need the row where the completed date is empty so that on a summary sheet
I can tell what still needs to be accomplished at a quick glance.

Again, thanks for your help.
Pam

"Ron de Bruin" wrote in message
...
Hi Pam

You need to filter each sheet before you copy or filter the summery sheet
when the merge
macro is ready and delete the rows you not want.

You say not a date
Date are just numbers so you have empty cells in M and cells with a
number/Date
Am I correct ?

I will post a example this evening for you if you answer this

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Pam" wrote in message
...
Hi,

Using Ron de Bruin's code below to copy range from worksheets to one
master sheet, how can I copy just those rows in each range from each page
that do not have a date in the "m" column? I need a summary of action
items for each person that haven't been completed yet. Is this possible?

Thanks in advance for any help.
Pam

Sub CopyRangeFromMultiWorksheets()

Dim sh As Worksheet

Dim DestSh As Worksheet

Dim Last As Long

Dim CopyRng As Range

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

'Delete the sheet "RDBMergeSheet" if it exist

Application.DisplayAlerts = False

On Error Resume Next

ActiveWorkbook.Worksheets("RDBMergeSheet").Delete

On Error GoTo 0

Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"

Set DestSh = ActiveWorkbook.Worksheets.Add

DestSh.Name = "RDBMergeSheet"

'loop through all worksheets and copy the data to the DestSh

For Each sh In ActiveWorkbook.Worksheets

If sh.Name < DestSh.Name Then

'Find the last row with data on the DestSh

Last = LastRow(DestSh)

'Fill in the range that you want to copy

Set CopyRng = sh.Range("A1:G1")

'Test if there enough rows in the DestSh to copy all the data

If Last + CopyRng.Rows.Count DestSh.Rows.Count Then

MsgBox "There are not enough rows in the Destsh"

GoTo ExitTheSub

End If

'This example copies values/formats, if you only want to copy the

'values or want to copy everything look at the example below this macro

CopyRng.Copy

With DestSh.Cells(Last + 1, "A")

.PasteSpecial xlPasteValues

.PasteSpecial xlPasteFormats

Application.CutCopyMode = False

End With

'Optional: This will copy the sheet name in the H column

DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name

End If

Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet

DestSh.Columns.AutoFit

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub


.