Copy rows then delete them

  • Thread starter Thread starter Richard
  • Start date Start date
R

Richard

Hello,

Using Excel XP

Assistance in the following matter will be greatly
appreciated.

I have 2 workbooks, both of which are opened, named
Source.xls and Dest.xls. Each workbook consists of one
sheet, named say Sheet1.

Source.xls has data starting in row 7, columns A:K.
Column D has dates (Excel formatted) or blanks. The first
objective is to scan column D in Source.xls for dates
older than 10 days from today, and if found, copy the
entire row to Dest.xls, starting in row 7 downward. The
second objective is to then delete the copied row from
Source.xls.

The following macro from Mr. JE McGinpsey is brilliant in
finding the relevant rows and deleting them, but I need
to copy the rows to Dest.xls first (the macro has been
amended to exclude blanks in column D)

Sub DeleteOldRows()
Dim cell As Range
Dim delRange As Range
Dim TenDaysAgo As Double

TwoDaysAgo = Date - 10
For Each cell In Range("D7:D" & Range("D" & _
Rows.Count).End(xlUp).Row)
If cell.Value < TenDaysAgo And cell.Value <> "" Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then delRange.EntireRow.Delete
End Sub

I have got myself into a major mess with various attempts
to amend the macro by including code such as:
Set wk1 = Workbooks("Dest.xls")
Set rng1 = wk1.Worksheets("Sheet1").Range("A7:A" & Range
("A" & Rows.Count).End(xlUp).Row)

If Not delRange Is Nothing Then delRange.EntireRow.Copy
rng1

The additional code is not looping properly in Dest.xls.
TIA

Richard
 
Hi,

Maybe this works, but I m not sure...You may have to ordonnate your row in dest...good luck lol
Benjamin


Sub DeleteOldRows()
Dim cell As Range
Dim delRange As Range
Dim TenDaysAgo As Double


x=0
TwoDaysAgo = Date - 10
For Each cell In Range("D7:D" & Range("D" & _
Rows.Count).End(xlUp).Row)
If cell.Value < TenDaysAgo And cell.Value <> "" Then
x=x+1

windows("Dest").activate

If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then delRange.EntireRow.copy
windows("dest").activate
Range("A7").select
activesheet.paste

windows("source").activate
If Not delRange Is Nothing Then delRange.EntireRow.Delete
End Sub
 
Ben,

Thank you for your time and effort but nothing is being
pasted to Dest.xls. In addition, the rows in Source.xls
are not being deleted.

Regards,

Richard
-----Original Message-----
Hi,

Maybe this works, but I m not sure...You may have to
Click to expand...
ordonnate your row in dest...good luck lol
 
Here is an example of copy/delete that you can modify to suit. If you wanted
to copy without deleting just substitute copy for cut.

Worksheets("Sheet1").Range("A:ZZ").Cut _
Worksheets("Sheet2").Range("A:ZZ")
 
Back
Top