Solved

Adding names to worksheets during merging

Posted on 2013-10-31
4
313 Views
Last Modified: 2013-10-31
Hi guys

I have an output in the form of multiple worksheets.
I have found a solution to merge them all toghether into one workbook. But I would like the sheets to be named after the original file name.

Lets say my file is called 9252400.xlsx, i would then like the corresponding sheet in the workbook to be called 9252400

The code I am using for merging is:

Sub GetSheets()
Path = "C:\Documents and Settings\DAJO\My Documents\MD-CPH\PI_Database\0908315-3\PlantInfo_Excel\"
Filename = Dir(Path & "*.xls")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy after:=ThisWorkbook.Sheets(1)
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
End Sub

Open in new window


Do one of you have a good idea on how to do that?

Br/Danny
0
Comment
Question by:dannyjoer
  • 2
  • 2
4 Comments
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 39613955
Hi,

pls try the nwe sheet is always the 2nd

Sub GetSheets()
Path = "C:\Documents and Settings\DAJO\My Documents\MD-CPH\PI_Database\0908315-3\PlantInfo_Excel\"
Filename = Dir(Path & "*.xls")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
        Sheet.Copy after:=ThisWorkbook.Sheets(1)
        ThisWorkbook.Sheets(2).Name = Left(Filename, Len(Filename) - 4)
     Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
End Sub

Open in new window

Regards
0
 

Author Comment

by:dannyjoer
ID: 39614076
It actually works alright, I just think I haven't expressed my self good enough :) All the data is contained in the first sheet in all the different workbooks I want to merge.

So I wanna copy the first sheet from each workbook in my directory, name it the filename, and the finally merge it into one workbook.

Can you help with that? :)

Br/Danny
0
 
LVL 49

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 39614144
If you only want the first sheet of each file and create a new file

pls try

Sub GetSheets()
strPath = "C:\Documents and Settings\DAJO\My Documents\MD-CPH\PI_Database\0908315-3\PlantInfo_Excel\"
Filename = Dir(strPath & "*.xls")
Set wbkDest = Workbooks.Add
  Do While Filename <> ""
     Set wbkOrig = Workbooks.Open(Filename:=strPath & Filename, ReadOnly:=True)
     wbkOrig.Sheets(1).Copy before:=wbkDest.Sheets(1)
     wbkDest.Sheets(1).Name = Left(Filename, Len(Filename) - 4)
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
  
  wbkDest.SaveAs strPath & "Result.xls"
End Sub

Open in new window

Regards
0
 

Author Closing Comment

by:dannyjoer
ID: 39614180
Perfect Solution.. Simple and effective..
0

Featured Post

3 Use Cases for Connected Systems

Our Dev teams are like yours. They’re continually cranking out code for new features/bugs fixes, testing, deploying, testing some more, responding to production monitoring events and more. It’s complex. So, we thought you’d like to see what’s working for us.

Question has a verified solution.

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

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
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 …
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
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…

772 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