Copy range to multiple workbooks

[Crownman]

Hello All

I am trying to copy a range from a master workbook to a specific
location of several open workbooks. So far I have the following code
in my Personal.xls :

Sub UpdatePickList()
'
' UpdatePickList Macro
' Macro recorded 11/11/2009 by TOM
'
' Keyboard Shortcut: Ctrl+z
'
Sheets("LISTS").Select
Range("A5").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("TITLE").Select
End Sub

This code works, butI have to first open the master workbook and
select the appropriate range to copy (this range does not change) and
then activate each target workbook in turn and run the macro.

What I would ultimately like to do is the following

1. Have all of the code reside in the master workbook instead of
Personal.xls. This being done for someone else and I would prefer to
not require them to add the code to their Personal.xls.

2. Select one of the target workbooks, run the macro which would
select the appropriate range from the master workbook and copy it to
cell A5 on the "LISTS" worksheet of the target workbook.

3. Repeat for each target workbook.

If the code could automatically select each open target workbook and
do the copy and paste that would be even better.

Can anyone help with the coding for this. Thanks for any help.

Crownman

 

[Dave Peterson]

Can you trust the program to update any open workbook that has a worksheet named
Lists?

If yes, then this would go in the master workbook's project.

Option Explicit
Sub UpdatePickList()

Dim RngToCopy As Range
Dim TestWks As Worksheet
Dim wkbk As Workbook

'change the sheetname and range address
Set RngToCopy = ThisWorkbook.Worksheets("mstrsheet").Range("a1:A10")

For Each wkbk In Application.Workbooks
If wkbk.Name = ThisWorkbook.Name Then
'skip it, don't update master workbook.
Else
Set TestWks = Nothing
On Error Resume Next
Set TestWks = wkbk.Worksheets("Lists")
On Error GoTo 0

If TestWks Is Nothing Then
'lists doesn't exist in this workbook, skip it
'remove this line when done testing
MsgBox wkbk.Name & " not updated"
Else
RngToCopy.Copy _
Destination:=TestWks.Range("A5")
End If
End If
Next wkbk
End Sub

 

[Crownman]

Can you trust the program to update any open workbook that has a worksheet named
Lists?

If yes, then this would go in the master workbook's project.

Option Explicit
Sub UpdatePickList()

    Dim RngToCopy As Range
    Dim TestWks As Worksheet
    Dim wkbk As Workbook

    'change the sheetname and range address
    Set RngToCopy = ThisWorkbook.Worksheets("mstrsheet").Range("a1:A10")

    For Each wkbk In Application.Workbooks
        If wkbk.Name = ThisWorkbook.Name Then
            'skip it, don't update master workbook.
        Else
            Set TestWks = Nothing
            On Error Resume Next
            Set TestWks = wkbk.Worksheets("Lists")
            On Error GoTo 0

            If TestWks Is Nothing Then
                'lists doesn't exist in this workbook, skip it
                'remove this line when done testing
                MsgBox wkbk.Name & " not updated"
            Else
                RngToCopy.Copy _
                    Destination:=TestWks.Range("A5")
            End If
        End If
    Next wkbk
End Sub
















--

Dave Peterson- Hide quoted text -

- Show quoted text -

Dave:

Your code worked perfectly. You are the best!!

Thank you for your help.

Crownman