How to add additional worksheets to a directory of workbooks
 

Hi there,

I have a workbook for every employee in a directory which contains their
excel timesheets. I now need to add more worksheets for the next 6 months.
I have a workbook with a colum of names of the sheets I want to add and
another column of the employees names. How do I do this.

This is my macro so far

Sub UpdateTimeSheets()
Application.ScreenUpdating = False
Set FS = Application.FileSearch
strPath = "c:\TimeSheets"

n = 1
y = 1
For y = 1 To 4
With FS
.NewSearch
.LookIn = strPath
.SearchSubFolders = True
.Filename = ThisWorkbook.Sheets(2).Cells(y, 1)
iCount = .Execute

' strMessage = Format(iCount, "0 ""Files Found""")

For Each vaFileName In .FoundFiles
Set wb = Workbooks.Open(vaFileName)
' update workbook with additional worksheets with the names from
the 'period names' worksheet in column A rows 2 to 7
For x = 2 To 7
Set ws = Worksheets.Add(After:=Sheets(Sheets.Count))
ws.Name = ThisWorkbook.Sheets(1).Cells(x, 1)
wb.Close True ' save and close
Next x ' get next employees timesheet

Next
End With
Next y

Application.ScreenUpdating = True


End Sub

This opens up the first employee file but then it says it cannot rename the
worksheet.

Thanks in advance for your help.

How to add additional worksheets to a directory of workbooks
 

Maybe you're trying to use a name that is invalid.

There are certain names that can't be used (length of name has to be less than
32 characters, no duplicate names, no sheet named History in xl97+).

There are certain characters that cannot be used:
\, /, *, :, [, ]

So what is the name that's failing?

ibbm wrote:

Hi there,

I have a workbook for every employee in a directory which contains their
excel timesheets. I now need to add more worksheets for the next 6 months.
I have a workbook with a colum of names of the sheets I want to add and
another column of the employees names. How do I do this.

This is my macro so far

Sub UpdateTimeSheets()
Application.ScreenUpdating = False
Set FS = Application.FileSearch
strPath = "c:\TimeSheets"

n = 1
y = 1
For y = 1 To 4
With FS
.NewSearch
.LookIn = strPath
.SearchSubFolders = True
.Filename = ThisWorkbook.Sheets(2).Cells(y, 1)
iCount = .Execute

' strMessage = Format(iCount, "0 ""Files Found""")

For Each vaFileName In .FoundFiles
Set wb = Workbooks.Open(vaFileName)
' update workbook with additional worksheets with the names from
the 'period names' worksheet in column A rows 2 to 7
For x = 2 To 7
Set ws = Worksheets.Add(After:=Sheets(Sheets.Count))
ws.Name = ThisWorkbook.Sheets(1).Cells(x, 1)
wb.Close True ' save and close
Next x ' get next employees timesheet

Next
End With
Next y

Application.ScreenUpdating = True


End Sub

This opens up the first employee file but then it says it cannot rename the
worksheet.

Thanks in advance for your help.

--

Dave Peterson