?
Solved

Excel - VBA

Posted on 2011-03-21
9
Medium Priority
?
312 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
ID: 35184866
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
ID: 35184882
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
ID: 35185250
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
Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

 

Author Comment

by:ArisaAnsar
ID: 35185652
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
 

Author Comment

by:ArisaAnsar
ID: 35185689
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
ID: 35185732
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
ID: 35186157
Thank you.  The master workbook has four sheets.
0
 
LVL 10

Accepted Solution

by:
answer_dude earned 2000 total points
ID: 35192083
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
ID: 35333935
Thank you.  This worked
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

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

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

807 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