[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 340
  • Last Modified:

Adding names to worksheets during merging

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
dannyjoer
Asked:
dannyjoer
  • 2
  • 2
1 Solution
 
Rgonzo1971Commented:
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
 
dannyjoerAuthor Commented:
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
 
Rgonzo1971Commented:
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
 
dannyjoerAuthor Commented:
Perfect Solution.. Simple and effective..
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now