Solved

Excel - VBA

Posted on 2011-03-21
9
300 Views
Last Modified: 2012-05-11
I have three tabs on a spreadsheet that I have to insert into 126 different spreadsheet.   Is there a VBA code that will make this easier?
0
Comment
Question by:ArisaAnsar
  • 5
  • 4
9 Comments
 
LVL 10

Expert Comment

by:answer_dude
Comment Utility
Sure there is... :-)

Putting code in a master workbook that contains the three sheets that you need copied and then looping through a list of files and copying sheets is pretty straightforward.

Just need to know:
1.  How to find all of the spreadsheets that need the three sheets inserted?  Are they all in a single directory or do you have a list with path and file names?
2.  Do the sheets need to be added in any particular order?  Where should they be placed relative to sheets that already exist in the target workbooks?

0
 

Author Comment

by:ArisaAnsar
Comment Utility
Thank you!  That is great news!
All of the files are in a single directly.
The path would be:  T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports

They would have to be added to the end of the workbook, after Sheet 1.  The order they are listed in my master spreadsheet is the same order I would want them pasted in the other work books.
0
 
LVL 10

Expert Comment

by:answer_dude
Comment Utility
I use the following code to work with Excel Files in a folder.  For proper credit -- I only wrote the code between the 'xxxxxxxxx indicators.  The file looping and control portion came from http://www.ozgrid.com/VBA/loop-through.htm

You want to change the path in the line:

.Lookin = ""

to be your path.

Put this code in your master workbook (the one with the three sheets), modify the path as indicated above, then run it.

PLEASE RUN THIS ON A TEST FOLDER WITH A SUBSET OF FILES FIRST


Sub RunCodeOnAllXLSFiles()

    Dim lCount As Long
    Dim wbResults As Workbook
    Dim wbCodeBook As Workbook
    
    'xxxxxxxxxxxxxxxxxxxxxxx
    'MY CODE
    Dim ws As Worksheet
    Dim bDone As Boolean
    'xxxxxxxxxxxxxxxxxxxxxxx
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    On Error Resume Next
        Set wbCodeBook = ThisWorkbook
            With Application.FileSearch
                .NewSearch
                'Change path to suit
                .LookIn = "C:\TestDir\Excel\File List\"
                .FileType = msoFileTypeExcelWorkbooks
                'Optional filter with wildcard
                '.Filename = "Book*.xls"
                    If .Execute > 0 Then 'Workbooks in folder
                        For lCount = 1 To .FoundFiles.Count 'Loop through all
                            'Open Workbook x and Set a Workbook variable to it
                            Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                            
                            'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
                            'MY CODE HERE
                            bDone = False
                            'Check to see if we've already copied our sheets to this
                            For Each ws In wbResults.Worksheets
                                If ws.Name = wbCodeBook.Sheets(1).Name Then
                                    'we've already edited this workbook
                                    bDone = True
                                End If
                            Next ws
                            If Not bDone Then
                                'copy sheets, close and save changes
                                wbCodeBook.Sheets(1).Copy After:=wbResults.Sheets(1)
                                wbCodeBook.Sheets(2).Copy After:=wbResults.Sheets(2)
                                wbCodeBook.Sheets(3).Copy After:=wbResults.Sheets(3)
                                wbResults.Close SaveChanges:=True
                            Else
                                'don't copy and close without saving
                                wbResults.Close SaveChanges:=False
                            End If
    
                            'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
                        Next lCount
                    End If
            End With
    On Error GoTo 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

Open in new window

0
 

Author Comment

by:ArisaAnsar
Comment Utility
I ran this in a test folder and it did not update the sheets and I did not receive an error message. Any ideas?
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 

Author Comment

by:ArisaAnsar
Comment Utility
Do I need to include the tab names within the code?  The three tabs that has to be copied to the other work books have been renamed.
0
 
LVL 10

Expert Comment

by:answer_dude
Comment Utility
no - you don't have to put the sheet names in the code - i assume the master workbook only has three sheets.

Be sure you have a final backslash on your path name.

You could also comment out the On Error Resume Next line so you can see any errors.
0
 

Author Comment

by:ArisaAnsar
Comment Utility
Thank you.  The master workbook has four sheets.
0
 
LVL 10

Accepted Solution

by:
answer_dude earned 500 total points
Comment Utility
In that case, you will need to put the names.  I've updated the code below to give you a count of number of files updated and I've commented out the resume next error handling.  You need to replace "Source1", "Source2", and "Source3" with the names of the sheets you want copied.  Note that "Source1" appears twice (the code checks to see if "Source1" already exists in the target workbook and if so, we don't try to copy the three sheets a second time.


Option Explicit

Sub RunCodeOnAllXLSFiles()

    Dim lCount As Long
    Dim wbResults As Workbook
    Dim wbCodeBook As Workbook
    
    'xxxxxxxxxxxxxxxxxxxxxxx
    'MY CODE
    Dim ws As Worksheet
    Dim bDone As Boolean
    Dim nUpdated As Integer
    'xxxxxxxxxxxxxxxxxxxxxxx
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    'On Error Resume Next
        Set wbCodeBook = ThisWorkbook
            With Application.FileSearch
                .NewSearch
                'Change path to suit
                .LookIn = "C:\TestDir\Excel\File List\"
                If Right(.LookIn, 1) <> "\" Then
                    .LookIn = .LookIn & "\"
                End If
                .FileType = msoFileTypeExcelWorkbooks
                'Optional filter with wildcard
                '.Filename = "Book*.xls"
                    If .Execute > 0 Then 'Workbooks in folder
                        For lCount = 1 To .FoundFiles.Count 'Loop through all
                            'Open Workbook x and Set a Workbook variable to it
                            Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                            
                            'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
                            'MY CODE HERE
                            bDone = False
                            'Check to see if we've already copied our sheets to this
                            For Each ws In wbResults.Worksheets
                                If ws.Name = wbCodeBook.Sheets("Source1").Name Then
                                    'we've already edited this workbook
                                    bDone = True
                                End If
                            Next ws
                            If Not bDone Then
                                'copy sheets, close and save changes
                                wbCodeBook.Sheets("Source1").Copy After:=wbResults.Sheets(1)
                                wbCodeBook.Sheets("Source2").Copy After:=wbResults.Sheets(2)
                                wbCodeBook.Sheets("Source3").Copy After:=wbResults.Sheets(3)
                                wbResults.Close SaveChanges:=True
                                nUpdated = nUpdated + 1
                            Else
                                'don't copy and close without saving
                                wbResults.Close SaveChanges:=False
                            End If
    
                            'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
                        Next lCount
                    End If
            End With
    On Error GoTo 0
    MsgBox nUpdated & " Excel Files Updated"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

Open in new window

0
 

Author Closing Comment

by:ArisaAnsar
Comment Utility
Thank you.  This worked
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

This very simple solution applies to a narrow cross-section of the "needs to close" variety. In this case, the full message in Event Viewer was in applog, Event ID 1000: Faulting application iexplore.exe, version 8.0.6001.18702, faulting module …
Many companies are making the switch from Microsoft to Google Apps (https://www.google.com/work/apps/business/). Use this article to learn more about what Google Apps has to offer and to help if you’re planning on migrating to Google Apps. It is …
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

762 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now