Solved

Insert a new worksheet named 'listings' in all xlsx-files of a given folder

Posted on 2012-04-12
4
178 Views
Last Modified: 2012-04-13
Dear Experts:

I would like to run a macro that accomplishes the following task:

Insert a worksheet named 'listings' in all files of a folder

The macro is to run from a xlsm-file that always resides in the folder where all the xlsx-files have to be worked on.

That is, the macro should work on any folder, i.e. - I guess - the code snippet 'ActiveWorkbook.path' should be part of the code.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
0
Comment
Question by:AndreasHermle
  • 2
  • 2
4 Comments
 
LVL 7

Expert Comment

by:hippohood
ID: 37841404
Hi,
the code below should do the job. Please, let me know if you have any issues with it

Sub InsertSheetInEveryFileInFolder()
Dim folderspec$

folderspec = Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - Len(ThisWorkbook.Name))

Dim fs, f, fc, f1, wb As Workbook, ws
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each f1 In fc
    If UCase(Right(f1, 4)) = "XLSX" Then
        Set wb = Workbooks.Open(f1.FullName)
        Set ws = wb.Worksheets.Add
        ws.Name = "listings"
        wb.Close True
    End If
Next

End Sub

Open in new window

0
 

Author Comment

by:AndreasHermle
ID: 37841594
Hi hippohood,

thank you very much for your swift support.

I am afraid to tell you that your code throws an error message on Line 12. Error Message is 438: Object does not support this property or method

Line 6 says 'ws' at the end. Shouldn't 'ws' be declared as well?

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
0
 
LVL 7

Accepted Solution

by:
hippohood earned 500 total points
ID: 37841794
Sorry, Andreas. This would depend on your library settings. To simplify things you can just remove ".FullName" on line 12.

BTW, this code requires that all the XLSX files are not open, not read-only and don't have a sheet named "listings" already. You can add on error resume next statement to avoid hlating the macro if either of those conditions are not true.

See below a corrected code
Sub InsertSheetInEveryFileInFolder()
Dim folderspec$

folderspec = Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - Len(ThisWorkbook.Name))

Dim fs, f, fc, f1, wb As Workbook, ws
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files

On Error Resume Next
For Each f1 In fc
    If UCase(Right(f1, 4)) = "XLSX" Then
        Set wb = Workbooks.Open(f1)
        Set ws = wb.Worksheets.Add
        ws.Name = "listings"
        wb.Close True
    End If
Next

End Sub
 

Open in new window

0
 

Author Closing Comment

by:AndreasHermle
ID: 37843200
Great, this did the trick.

Thank you very much for your professional and swift help.

Regards, Andreas
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

747 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now