Solved

Script or Macro to copy workbook to multiple workbooks Excel

Posted on 2011-09-21
5
433 Views
Last Modified: 2012-05-12
Hi,

I have a total of 100 workbooks in a folder and sub folders. I would like to be able to add another workbook as a new tab to each of the 100 workbooks mentioned previously. Is the best way to do this using a VB Script? Or would a macro be more suitable for this task. I have attempted to write a script to do it but having little experience, this is beyond me. I have tried to write a script that will reference a list containing the files required to be opened (100 workbooks). Once opened the script will add the existing worksheet as a new tab. Alas, I am unable to do so.

Does anyone have a script that can get me started or any pointers would be appreciated?

Thanks in advance
0
Comment
Question by:Mattywerts
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
5 Comments
 
LVL 5

Accepted Solution

by:
slycoder earned 500 total points
ID: 36578564
I have this setup in Safe Mode.  When you are ready to change the 100 files, please do so on a copy of them in another directory or on another drive.  This will be so you can see what the macro does, and your original files will not be damaged if the outcome is undesirable.

Thanks
 
Dim r As Long
Dim myFileList(101) As String

' WARNING - Please run this on a duplicate tree (not your original files) first
' this macro does not delete anything, but there is no "undo" of the additional sheets

' Set these to what your setup
Const myRoot = "g:\spreadsheets"
Const mySheetName = "NewWorksheet"

Public Sub main()
    r = 0
    ' and include subfolders (true/false)
    ListFolders myRoot, True
    
    ' Uncomment to display list of files in Immediate Window (debugging)
    Call showfiles
    
    ' Comment this line out if debugging and you do not wish to change the sheets yet.
    ' Call AddSheetToEachFile
End Sub


Public Sub ListFolders(SourceFolderName As String, IncludeSubfolders As Boolean)
    DoEvents
    Application.DisplayAlerts = False
    
    Dim fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
    
    
    Set fso = New Scripting.FileSystemObject
    Set SourceFolder = fso.GetFolder(SourceFolderName)
    
    On Error Resume Next
    
    Findfiles (SourceFolder.Path)
    
    If IncludeSubfolders Then
    
        For Each SubFolder In SourceFolder.SubFolders
            ListFolders SubFolder.Path, True
        Next SubFolder
        
        Set SubFolder = Nothing
    
    End If
    
    Set SourceFolder = Nothing
    Set fso = Nothing
    
End Sub


Public Sub Findfiles(d As String)

    fname = Dir(d & "\*.*")
    
    Do While fname <> ""
        myFileList(r) = d & "\" & fname
        r = r + 1
        fname = Dir
    Loop
End Sub

Sub AddSheetToEachFile()
    Dim myFile As Variant
    
    For Each myFile In myFileList
        If myFile <> "" Then
            Debug.Print myFile
        
            Workbooks.Open Filename:=myFile
            Sheets.Add After:=Sheets(Sheets.Count)
            Sheets(ActiveSheet.Name).Select
            Sheets(ActiveSheet.Name).Name = mySheetName
            ActiveWorkbook.Save
            ActiveWorkbook.Close
        End If
    Next myFile
    
End Sub


Public Sub showfiles()
    ' Can be called for debugging
    Dim myFile As Variant
    
    For Each myFile In myFileList
        If myFile <> "" Then
            Debug.Print myFile
        End If
    Next myFile
End Sub

Open in new window

0
 
LVL 5

Expert Comment

by:slycoder
ID: 36578572
It's late here - forgot to tell you - a reference to "Microsoft Scripting Runtime" is required to work with the FileSystemObject.

Please add this in the Macro IDE (Alt+F11) by selecting - Tools - References "Microsoft Scripting Runtime"

Thanks
0
 
LVL 5

Expert Comment

by:slycoder
ID: 36578589
>> Is the best way to do this using a VB Script? Or would a macro be more suitable for this task.

Either way really would work.  I use Excel in this solution so that I can "see" what I'm doing with the immediate window.  Also since you already have an instance of Excel opened, you can leverage the objects easier.

Thanks
0
 
LVL 5

Expert Comment

by:slycoder
ID: 36578604
One last note - make sure the file containing this macro is not in the set being processed.  I made that mistake and the program halted gracefully.  

I named the worksheet g:\MasterTemplateArray.xlsm and processed the files in g:\Spreadsheets.

Thanks.


0
 
LVL 1

Author Closing Comment

by:Mattywerts
ID: 36578686
Exactly what I was looking for. Thanks heaps
0

Featured Post

Get your Disaster Recovery as a Service basics

Disaster Recovery as a Service is one go-to solution that revolutionizes DR planning. Implementing DRaaS could be an efficient process, easily accessible to non-DR experts. Learn about monitoring, testing, executing failovers and failbacks to ensure a "healthy" DR environment.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

My attempt to use PowerShell and other great resources found online to simplify the deployment of Office 365 ProPlus client components to any workstation that needs it, regardless of existing Office components that may be needing attention.
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…

635 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question