Macro problem for timesheet

[celia]

Currently, I am doing a timesheet. The timesheet are given every
month.

For December, a file December.xls with sheet name - December as well is
given to them. Then, the staff are

required to rename the file same as their staff number. So, for staff
no. P101 and in December, the sheet

name is December where else the file name is P101.xls. And, so on.

Then, I have to manually renamed all the sheet name same as the
staff's' numbers. This for the purpose

where the formula that need to refer to data entered by the particular
staff, I can just easily refer by the

sheet name. The data neeed to be update once a month.

Now, I have to manually open the file and copy the sheet into a new
sheet and manually rename the sheet

name from December to the sttaff numbers. It might take a lot of time
because there are 35 staff now.

I would like to write a code in new excel file where it can refer to
the particular file(P101.xls) and copy the

sheet(December) into the new file and change the sheet name(to P101) as
well. Can such code be written in

Excel. Any one has any idea?

ANY HELP OR ADVICE WOULD BE GREATLY APPRECIATED !

Thanks,

Attachment filename: cal.xls
Download attachment: http://www.excelforum.com/attachment.php?postid=389182

 

[Dave Peterson]

This will copy the activesheet to a new workbook, change the name of the sheet
to a staff number and save that workbook using that staff number again.

Option Explicit
Sub testme()

Dim newWks As Worksheet
Dim wks As Worksheet
Dim myFolder As String

Dim StaffNumbers As Variant
Dim iCtr As Long

'I only did 3, you'll need to add all 35
StaffNumbers = Array("p101", "p102", _
"p135")

myFolder = "C:\my documents\excel\test\"
If Right(myFolder, 1) <> "\" Then
myFolder = myFolder & "\"
End If

Set wks = ActiveSheet 'make sure you're on the right sheet!

For iCtr = LBound(StaffNumbers) To UBound(StaffNumbers)
wks.Copy 'to a new workbook
Set newWks = ActiveSheet
With newWks
.Name = StaffNumbers(iCtr)
Application.DisplayAlerts = False
.Parent.SaveAs Filename:=myFolder & StaffNumbers(iCtr), _
FileFormat:=xlNormal
Application.DisplayAlerts = True
.Parent.Close savechanges:=False
End With

Next iCtr

End Sub

I figured that the staff numbers are pretty much a typing job--not sequential.

Don't forget to change the the folder to save to, too. This'll overwrite any
existing workbooks that are out there--so be careful when you run it.

 

[jaimy]

Where should I put the code?

I put the code in a new sheet, new workbook and put the files togethe
with the 35 files(with their own staff number) in the same folder
Then, i run the macro but it did'n work as u say.

What went wrong?

help,
celi

 

[celia]

Where should I put the code?

I put the code in a new sheet, new workbook and put the files together
with the 35 files(with their own staff number) in the same folder.
Then, i run the macro but it did'n work as u say.

What went wrong?

help,
celia

 

[Dave Peterson]

The code can go in any workbook's project. It does all the processing against
the activesheet, so all you have to do is make sure the worksheet that you want
to copy 35 times is the active.

This takes that one sheet and saves it to 35 (actually as many staffnumbers you
specify) and saves them to new workbooks--with that name.

This is the section that you have to modify for additional staff numbers:

StaffNumbers = Array("p101", "p102", _
"p135")

Did I read your original post incorrectly?

 

[celia]

I try with 3 workbooks- p101.xls, p102.xls and p103.xls. They have the
same sheet name- December. They all save in the same folder. I open up
all the workbooks, and put the codes in one of the workbooks. I run the
macro but it only copy the first one-P101 into a new workbook. I also
try in other workbook and it does the same also.

What I want is copy the sheet(December) from the 3
workbook(p101,p102,p103.xls) into the new wokbook and rename the sheet
name according to the staff number respectively.

I changed the line of code here and the location where the files are.

StaffNumbers = Array("p101", "p102", _
"p103")

I am sorry if you got my post incorrectly but I hope you can understand
this time and give me some advice.

Thanks & Merry Christmas,

 

[Dave Peterson]

So you have 35 different workbooks named p101.xls, ..., p###.xls. And each of
those sheets has a worksheet named December. And you want to take a copy of
each worksheet and make a new workbook with 35 worksheets--December of each
workbook?

Option Explicit
Sub testme02()

Application.ScreenUpdating = False

Dim newWkbk As Workbook
Dim wksMonthName As String
Dim wks As Worksheet
Dim wkbk As Workbook
Dim StaffNumbers As Variant
Dim iCtr As Long
Dim myFolder As String

'I only did 3, you'll need to add all 35
StaffNumbers = Array("p101", "p102", _
"p135")

wksMonthName = "December"

myFolder = "C:\my documents\excel\"
If Right(myFolder, 1) <> "\" Then
myFolder = myFolder & "\"
End If

Set newWkbk = Workbooks.Add(1)
newWkbk.Worksheets(1).Name = "deletemelater"

For iCtr = LBound(StaffNumbers) To UBound(StaffNumbers)
If Dir(myFolder & StaffNumbers(iCtr) & ".xls") = "" Then
MsgBox myFolder & StaffNumbers(iCtr) & _
".xls workbook doesn't exist"
Else
Set wkbk = Workbooks.Open(Filename:=myFolder & _
StaffNumbers(iCtr) & ".xls", _
UpdateLinks:=0, ReadOnly:=True)

Set wks = Nothing
On Error Resume Next
Set wks = wkbk.Worksheets(wksMonthName)
On Error GoTo 0

If wks Is Nothing Then
MsgBox StaffNumbers(iCtr) & _
" doesn't have a worksheet named: " & wksMonthName
Else
wks.Copy _
before:=newWkbk.Worksheets(newWkbk.Worksheets.Count)
ActiveSheet.Name = StaffNumbers(iCtr)
End If
wkbk.Close savechanges:=False
End If
Next iCtr

If newWkbk.Worksheets.Count > 1 Then
Application.DisplayAlerts = False
newWkbk.Worksheets("deletemelater").Delete
Application.DisplayAlerts = True
MsgBox "Don't forget to save this workbook!"
Else
newWkbk.Close savechanges:=False
MsgBox "No files merged!"
End If

Application.ScreenUpdating = True

End Sub

You'll still have to type in the filenames. And you'll have to save the output
workbook when it's done.