I
ibbm
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.
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.