- Tham gia
- 14/6/06
- Bài viết
- 1,137
- Được thích
- 2,297
- Nghề nghiệp
- Tư vấn giải pháp bán lẻ
Đây là 1 đoạn code để copy 1 sheet trong file excel sang 1 file mới.
Copyright (c) by PSC
Mã:
Private Function CopySheet(ByVal strSource As String, _
ByVal strDestination As String)
On Error Goto CopySheet_Error
Dim objExcel As New Excel.Application
Dim objWorkSheet As New Excel.Worksheet
Dim objWorkBook As New Excel.Workbook
Dim objNewWorkBook As New Excel.Workbook
Dim fsoObject As New FileSystemObject
'create a new excel instance
Set objExcel = CreateObject("Excel.Application")
'make excel invisible
objExcel.Visible = False
'open the source spreedsheet
Set objWorkBook = objExcel.Workbooks.Open(strSource)
'set the sheet to the active (first shee
' t in workbook)
Set objWorkSheet = objWorkBook.ActiveSheet
'copy the active sheet
objWorkSheet.Copy
'if the destination exists, kill it
If fsoObject.FileExists(strDestination) = True Then
fsoObject.DeleteFile strDestination
End If
'save the duplicate in a new spreedsheet
'
Set objNewWorkBook = objExcel.Workbooks(2)
objNewWorkBook.SaveAs (strDestination)
'turn off excel alerts
objExcel.DisplayAlerts = False
'quit excel
objExcel.Quit
Exit Function
CopySheet_Error:
MsgBox "Error Number: " & Err.Number & vbNewLine & "Description: " & Err.Description
End Function
Copyright (c) by PSC