[2 days left] What’s wrong with your cloud strategy? Learn why multicloud solutions matter with Nimble Storage.Register Now

x
?
Solved

Edit macro to include two extra worksheets data to be copied

Posted on 2013-01-21
6
Medium Priority
?
347 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
Technology Partners: 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 2000 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

On Demand Webinar: Networking for the Cloud Era

Ready to improve network connectivity? Watch this webinar to learn how SD-WANs and a one-click instant connect tool can boost provisions, deployment, and management of your cloud connection.

Question has a verified solution.

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

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
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…

649 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