Copy worksheet to multiple workbooks

[belldog]

Greetings,

I have a spreadsheet that I need to copy, as a new tab, to about 160 workbooks. Is there a quick way to do this?

Thanks in advance for any help.

belldog

 

[John_w]

Try this. First, copy the 160 workbooks to a test folder. Then include the code below in a Sheet module or standard module of the workbook to copy from, modify the folder name and source sheet name as required and run the sub and check the results to make sure it works as required.

Option Explicit

Public Sub CopySheetToAllWorkbooksInFolder()

    Dim sourceSheet As Worksheet
    Dim folder As String, filename As String
    Dim destinationWorkbook As Workbook
    
    'Worksheet in active workbook to be copied as a new sheet to the 160 workbooks
    
    Set sourceSheet = ActiveWorkbook.Worksheets("Sheet1")
    
    'Folder containing the 160 workbooks
    
    folder = "F:\temp\excel\"
       
    filename = Dir(folder & "*.xls", vbNormal)
    While Len(filename) <> 0
        Debug.Print folder & filename
        Set destinationWorkbook = Workbooks.Open(folder & filename)
        sourceSheet.Copy before:=destinationWorkbook.Sheets(1)
        destinationWorkbook.Close True
        filename = Dir()  ' Get next matching file
    Wend

End Sub

 

[belldog]

Thanks for the help, although I am unable to get it to work.

I am new to VBA and unsure of the fix. Attached is the result when I run it.

The set sourcesheet= is highlighted in yellow after the runtime error occurs.

The sheet I am trying to copy to the workbooks is called "address tab"




Public Sub CopySheetToAllWorkbooksInFolder()
Dim sourceSheet As Worksheet
Dim folder As String, filename As String
Dim destinationWorkbook As Workbook

'Worksheet in active workbook to be copied as a new sheet to the 160 workbooks

Set sourceSheet = ActiveWorkbook.Worksheet("address")

'Folder containing the 160 workbooks

folder = "C:\Documents and Settings\Owner\My Documents\prepacking HK\us orders by order\Test"

filename = Dir(folder & "*.xls", vbNormal)
While Len(filename) <> 0
Debug.Print folder & filename
Set destinationWorkbook = Workbooks.Open(folder & filename)
sourceSheet.Copy before:=destinationWorkbook.Sheets(1)
destinationWorkbook.Close True
filename = Dir() ' Get next matching file
Wend
End Sub

 

[John_w]

The set sourcesheet= is highlighted in yellow after the runtime error occurs.

What is the exact and complete run-time error message?

The sheet I am trying to copy to the workbooks is called "address tab"
:
:

Set sourceSheet = ActiveWorkbook.Worksheet("address")

Which is correct - "address tab" or "address"? Whichever it is, that sheet must exist in the workbook in which my code runs, and the Set sourceSheet statement must reflect that sheet name.

 

[belldog]

Error:

Run time error "424':

Object required

The workbook is called "address tab". The sheet is named "address".

Thanks for your help.

 

[John_w]

Looks like you introduced an error in the original code. Change:

Set sourceSheet = ActiveWorkbook.Worksheet("address")

to:

Set sourceSheet = ActiveWorkbook.Worksheets("address")

If you have another workbook open and the code isn't in the active workbook, then try:

Set sourceSheet = ThisWorkbook.Worksheets("address")

 

[belldog]

Hi,

I made the changes, but I get no activity when I run the macro (no error either)

Thanks

 

[John_w]

Put a backslash on the end of the folder path, as in my original code.

With that, all problems should be sorted. If still no joy, step through the code using F8 in the VB Editor to understand what it's doing.

 

[belldog]

That did the trick! Thank you very much. I know a lot more now than I did yesterday.

Cheers

 

[leecavturbo]

will this work for any amount of workbooks?
why is 160 workbooks in the code?