Solved: Need to extract to new workbook

[jammer6_9]

How can I let this code to save sheets in to new workbook?

[vba]
Sub CopyData()
Dim Arr(), a, tp As Worksheet, sh As Range
Dim i As Long
Application.ScreenUpdating = False

ReDim Arr(0)
i = -1
With Sheets("SALARY LIST")
For Each sh In Range(.Cells(3, 1), .Cells(3, 1).End(xlDown))
i = i + 1
ReDim Preserve Arr(i)
Arr(i) = sh
Next
End With

Set tp = Sheets("TEMP")
For Each a In Arr
tp.Range("C12") = a

tp.Copy After:=Sheets(Sheets.Count)

Sheets(Sheets.Count).Name = a

Next

Application.ScreenUpdating = True

End Sub
[/vba]

[jammer6_9]

File is attache... I just need employee pay slip to be extracted in a new workbook...

[jammer6_9]

[VBA]
Sub CopyData()
Dim Arr(), a, tp As Worksheet, sh As Range
Dim i As Long
Application.ScreenUpdating = False

'Put names into an array
ReDim Arr(0)
i = -1
With Sheets("SALARY LIST")
For Each sh In Range(.Cells(3, 1), .Cells(3, 1).End(xlDown))
i = i + 1
ReDim Preserve Arr(i)
Arr(i) = sh
Next
End With

'Add name to template
Set tp = Sheets("TEMP")
For Each a In Arr
tp.Range("C12") = a
'Copy to a new sheet
tp.Copy After:=Sheets(Sheets.Count)
'Rename
Sheets(Sheets.Count).Name = a
'Fix values
Sheets(a).Range("A1:A43").Value = Sheets(a).Range("A1:A43").Value 'Having Error here
Next
'Move name sheets to new workbook
Sheets(Arr).Move
Application.ScreenUpdating = True

End Sub

[/VBA]

[jammer6_9]

I FOUND SOLUTION...

[VBA]
Sub CopyData()
Dim w As Workbook, ws As Worksheet, ss As Worksheet
Dim Arr(), a, tp As Worksheet, sh As Range
Dim i As Long
Application.ScreenUpdating = False

ReDim Arr(0)
i = -1
With Sheets("SALARY LIST")
For Each sh In Range(.Cells(3, 1), .Cells(3, 1).End(xlDown))
i = i + 1
ReDim Preserve Arr(i)
Arr(i) = sh
Next
End With

Set tp = Sheets("TEMP")
For Each a In Arr
tp.Range("C12") = a

tp.Copy after:=Sheets(Sheets.Count)

Sheets(Sheets.Count).Name = a

Next

Application.ScreenUpdating = True

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "SALARY LIST" And ws.Name <> "TEMP" Then
If w Is Nothing Then
ws.Move
Set w = ActiveWorkbook
Else
ws.Move after:=ss
End If
Set ss = ActiveSheet
End If
Next ws
ThisWorkbook.Activate

End Sub
[/VBA]