Copying data into a number of other workbooks

[Mike Magill]

Hi,

I'm trying to write a macro that copies a data range from this
workbook into a number of other workbooks specified by the user. The
macro so far is as set out below but it keeps failing at the Paste
stage and I think the copy command is deactivated by that point. I
don't know how to correct the code. Any help is appreciated.

Thanks

Sub DataUpdate()

Dim fn As Variant, f As Integer

ActiveSheet.Unprotect Password:="Password"

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Set SumSht = ThisWorkbook.Sheets("Standard Risk Descriptions")

fn = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select ALL the current Risk Registers that you wish to
update", , True)
If TypeName(fn) = "Boolean" _
Then
ActiveSheet.Protect Password:="Password",
DrawingObjects:=True, Contents:=True, Scenarios:=True,
AllowFormattingColumns:=True
Range("I2").Select

Exit Sub
Else
End If

Application.ScreenUpdating = True
Application.ScreenUpdating = False



Sheets("Standard Risk Descriptions").Select
Range("B4:C29").Select
Selection.Copy

For f = 1 To UBound(fn)
Workbooks.Open fn(f)
On Error GoTo Errhandler1
Sheets("Standard Risk Descriptions").Select
ActiveSheet.Unprotect Password:="Password"
Range("B4:C29").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Protect Password:="Password",
DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingRows:=True, AllowFiltering:= _
True

Call CloseAllInactive
Next f

Application.CutCopyMode = False

Range("i4").Select

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True

ActiveSheet.Protect Password:="Password", DrawingObjects:=True,
Contents:=True, Scenarios:=True _
, AllowFormattingRows:=True, AllowFiltering:= _
True

MsgBox "The update data process" & vbNewLine & _
"has finished."

Exit Sub

Errhandler1:

' If an error occurs, display a message and end the macro.
MsgBox "You have selected an incorrect spreadsheet" & vbNewLine
& _
"(i.e. not a standard risk register spreadsheet)." & vbNewLine
& vbNewLine & _
"The macro will now end and you need to start again."

ThisWorkbook.Activate

Call CloseAllInactiveUnsaved

Exit Sub


End Sub

Public Sub CloseAllInactive()

Dim Wb As Workbook
Dim AWb As String
AWb = ActiveWorkbook.Name

For Each Wb In Workbooks
If Wb.Name <> AWb Then
Wb.Save
Wb.Close savechanges:=True
End If
Next Wb

End Sub

Public Sub CloseAllInactiveUnsaved()

Dim Wb As Workbook
Dim AWb As String
AWb = ActiveWorkbook.Name

For Each Wb In Workbooks
If Wb.Name <> AWb Then
Wb.Close savechanges:=False
End If
Next Wb

End Sub