This is a shortened version as it's rather repetitive. The key cells ar
B20:C20 as they contain the region name.


Code
-------------------
Sub macro1()
'
' macro1 Macro
' Macro recorded 21/04/2005 by Mike Cobb
'

'
If Sheet1.Range("C4").Value = vbNullString Then
MsgBox "******** Please fill in the PHC Number ********", vbCritical
Exit Sub
End If

If Sheet1.Range("H49").Value = vbNullString Then
MsgBox "******* The DOV Has Not Been Signed and Returned *******", vbCritical
Exit Sub
End If

Workbooks.Open FileName:= _
"\\wdb.local\burton\work\JML\REM\12345.xls"
Sheets("Division").Select
Range("A8").Select
Selection.EntireRow.Insert
Windows("Fastrac formmac.xls").Activate
Range("C4").Select
Selection.Copy
Windows("12345.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Fastrac formmac.xls").Activate
Range("F4:G4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("12345.xls").Activate
Range("B8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C8").Select
Windows("Fastrac formmac.xls").Activate
Range("F6:G6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("12345.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D8").Select
Windows("Fastrac formmac.xls").Activate
Range("E11:F11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("12345.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E8").Select
Windows("Fastrac formmac.xls").Activate
Range("E14:F14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("12345.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F8").Select
Windows("Fastrac formmac.xls").Activate
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("12345.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G8").Select
Windows("Fastrac formmac.xls").Activate
Range("B20:C20").Select
Application.CutCopyMode = False
Selection.Copy
Windows("12345.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H8").Select
Windows("Fastrac formmac.xls").Activate
Range("E20:F20").Select
Application.CutCopyMode = False
Selection.Copy
Windows("12345.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I8").Select

End Su
-------------------

--
M3Cob
-----------------------------------------------------------------------
M3Cobb's Profile: http://www.excelforum.com/member.php...fo&userid=2498
View this thread: http://www.excelforum.com/showthread.php?threadid=38517