Solved

Edit macro to include two extra worksheets data to be copied

Posted on 2013-01-21
6
337 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
Independent Software Vendors: 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

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!

Question has a verified solution.

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

Suggested Solutions

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
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…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

739 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