Macro to move a worksheet once a job has closed

M

Mustang

I would like to achieve the following with a macro but not sure how to....

I have a multi sheet workbook which contains information on open jobs. I
have a status column and once this status has turned to 'Closed' I would like
to move this sheet to another workbook named Closed Jobs.

Any ideas would be gratefully received.

Many thanks
 
J

JBeaucaire

With no info about the names of the active jobs book, or where this "closed"
flag is, you'll have to edit this down:

==================
Option Explicit

Sub ArchiveClosedJobs()
Dim ws As Worksheet

'Check if destination workbook is open already, open it if necessary
On Error Resume Next
Workbooks("Closed Jobs.xls").Activate
If Err <> 0 Then Workbooks.Open "Closed Jobs.xls"
Workbooks("Open Jobs.xls").Activate

For Each ws In Worksheets
ws.Activate
If Range("J2").Value = "Closed" Then
MsgBox "J2 = closed"
ActiveSheet.Move After:=Workbooks("Closed
Jobs.xls").Sheets(Worksheets.Count)
Workbooks("Open Jobs.xls").Activate
End If
Next ws

End Sub
=================
This will go through ALL the worksheets in the workbook and check J2 for a
"closed" status, the ones that have that will be moved to the other workbook.

Let me know if that does the job for you.
 
J

JBeaucaire

In the macro given previously, you can remove this line:

MsgBox "J2 = closed"

I just used that to help be debug the code.
 
M

Mustang

Hi,

Thanks for the speedy response. It did work for me, however, I have now
been asked for something slightly different.

The job information is now to be held on one worksheet (instead of various
ones) and the aim is now to locate those jobs flagged with "Closed" in lets
say column J and moved to the Closed Jobs.xls. So I am looking for a row to
move not a column.

I should ask to go on a VB course!!!!

Thanks
 
J

JBeaucaire

Sorry I was away for several days. OK. Try this version then, the macro
should be put IN the OPEN JOB.XLS document. Edit the OJ and CJ strings at the
top if the names are incorrect.

===========
Option Explicit

Sub MoveClosedJobs()
Dim NextRow As Long, LastRow As Long
Dim OJ As String, CJ As String
OJ = "Open Jobs.xls"
CJ = "Closed Jobs.xls"
Application.ScreenUpdating = False

'Check if destination workbook is open already, open it if necessary
On Error Resume Next
Workbooks(CJ).Activate
If Err <> 0 Then Workbooks.Open CJ
On Error GoTo 0
NextRow = Range("J" & Rows.Count).End(xlUp).Row + 1

'Move CLOSED jobs
Workbooks(OJ).Activate
LastRow = Range("J" & Rows.Count).End(xlUp).Row

Range("J1").AutoFilter
Range("J1").AutoFilter Field:=1, Criteria1:="Closed"
Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Select
Selection.Copy
Workbooks(CJ).Sheets("Sheet1").Range("A" & NextRow).PasteSpecial xlPasteAll
Selection.Delete (xlShiftUp)
Range("J1").AutoFilter
Range("A1").Select

'Close CLOSED JOBS
Workbooks(CJ).Close True
Application.ScreenUpdating = True
End Sub
=============

Does that work for you?
 

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