Solved

Edit macro to include two extra worksheets data to be copied

Posted on 2013-01-21
6
332 Views
Last Modified: 2013-02-01
Hi Experts

I have the following macro that copies data in sequence from one workbook (worksheet) to another.

It currently copies data from or worksheet "cm" template file to master file worksheet "cm1"

I want it now to copy data from worksheet "orange" to "orange1" and worksheet "apple" to "apple1" in the master template...

All files are in the same c:\ path...same sequence as below:-

Sub Conso()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim strFilename As String

    Set wbDst = ThisWorkbook  ' Workbooks.Open("C:\Documents and Settings\Test\Master Template.xls")
   
    strFilename = Dir("C:\Documents and Settings\Test\*.xls")
   
    While strFilename <> ""
   
        If strFilename <> wbDst.Name Then
       
            Set wbSrc = Workbooks.Open("C:\Documents and Settings\Test\" & strFilename)
           
                 wbSrc.Worksheets("cm").UsedRange.Copy wbDst.Worksheets("cm1").Range("A" & Rows.Count).End(xlUp).Offset(1)

           
            wbSrc.Close
        End If
       
        strFilename = Dir()
       
    Wend
                 
End Sub
0
Comment
Question by:route217
  • 3
  • 3
6 Comments
 
LVL 24

Expert Comment

by:Steve
ID: 38803301
If this is all in the same workbook then the following may do it:

Sub Conso()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim strFilename As String

    Set wbDst = ThisWorkbook  ' Workbooks.Open("C:\Documents and Settings\Test\Master Template.xls")
    
    strFilename = Dir("C:\Documents and Settings\Test\*.xls")
    
    While strFilename <> ""
    
        If strFilename <> wbDst.Name Then
        
            Set wbSrc = Workbooks.Open("C:\Documents and Settings\Test\" & strFilename)


'on error resume next        
wbSrc.Worksheets("cm").UsedRange.Copy wbDst.Worksheets("cm1").Range("A" & wbDst.Rows.Count).End(xlUp).Offset(1)
                 
wbSrc.Worksheets("orange").UsedRange.Copy wbDst.Worksheets("orange1").Range("A" & wbDst.Rows.Count).End(xlUp).Offset(1)

wbSrc.Worksheets("apple").UsedRange.Copy wbDst.Worksheets("apple1").Range("A" & wbDst.Rows.Count).End(xlUp).Offset(1)
'on error goto 0
            

             wbSrc.Close
        End If
        
        strFilename = Dir()
        
    Wend
                 
End Sub 

Open in new window


Though I am likely getting the wrong idea here :)

Added the on error lines to skip errors (sheet not exist etc).. just remove the single apostrophe to use them.
0
 

Author Comment

by:route217
ID: 38803389
The final sheets are in the same workbook... The data is taken from different workbooks...

Many thanks for the positive feedback barman..
0
 
LVL 24

Expert Comment

by:Steve
ID: 38804362
Then the code would work, providing the error handling is on.

It will then pull the data from any of the open files which contain the sheets named.
The error you would get from not having the sheet present will then be skipped.

So try the code without the apostrophe before the error lines and see how it goes :)
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:route217
ID: 38804499
Hi Barman

The file where the Sara is taken from well not be open but stored/saved on the c:\ drive....

Will the code still work ? I would expect themes to open the files/workbooks one by one and copy and paste the data into the master workbook..
0
 
LVL 24

Accepted Solution

by:
Steve earned 500 total points
ID: 38804567
The code as it stands opens the .xls files in location "C:\Documents and Settings\Test\" one at a time and then will attempt to copy the data from each of the three sheets into the master workbook sheet of the same name +1.

The error line will skip the copy when there is an error (no sheet in source workbook)
providing the workbooks you are copying from are all in this loaction you should be fine.

If you need to add more locations the code will need to change to allow for this.
So providing the files are all in one place I think this code should do the job...

Sub Conso()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim strFilename As String

    Set wbDst = ThisWorkbook  ' Workbooks.Open("C:\Documents and Settings\Test\Master Template.xls")
    
    strFilename = Dir("C:\Documents and Settings\Test\*.xls")
    
    While strFilename <> ""
    
        If strFilename <> wbDst.Name Then
        
            Set wbSrc = Workbooks.Open("C:\Documents and Settings\Test\" & strFilename)

on error resume next        
wbSrc.Worksheets("cm").UsedRange.Copy wbDst.Worksheets("cm1").Range("A" & wbDst.Rows.Count).End(xlUp).Offset(1)
                 
wbSrc.Worksheets("orange").UsedRange.Copy wbDst.Worksheets("orange1").Range("A" & wbDst.Rows.Count).End(xlUp).Offset(1)

wbSrc.Worksheets("apple").UsedRange.Copy wbDst.Worksheets("apple1").Range("A" & wbDst.Rows.Count).End(xlUp).Offset(1)
on error goto 0
            
             wbSrc.Close
        End If
        
        strFilename = Dir()
        
    Wend
                 
End Sub 

Open in new window

0
 

Author Comment

by:route217
ID: 38843601
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

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

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

713 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