Solved

Edit macro to include two extra worksheets data to be copied

Posted on 2013-01-21
6
318 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
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 

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

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Excel User Form VBA Help 18 30
Count Unique Values in column if cell matches 3 23
Excel - DATEDIF error #NUM 6 12
sumifs excel 2013 3 7
Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

785 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