Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copying data into a number of other workbooks
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copying data between workbooks | Excel Programming | |||
copying same data to several Workbooks | Excel Programming | |||
Copying data between Workbooks | Excel Programming | |||
Copying data between workbooks? | Excel Discussion (Misc queries) | |||
Copying Data from closed workbooks | Excel Programming |