Solved

Edit macro to include two extra worksheets data to be copied

Posted on 2013-01-21
6
341 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
[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
  • 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

Featured Post

PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

Question has a verified solution.

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

Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
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…

688 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