求VB复制EXCEL中的sheet的完整源代码? navy102019@163.com

---

自己在程序里引用excel，添加command1，然后把代薯态码复制进去前迹

Dim ExlApp As Excel.Application
Dim ExlApp2 As Excel.Application
Dim ExlBook As Excel.Workbook
Dim ExlBook2 As Excel.Workbook
Dim ExlSheet As Excel.Worksheet
Dim ExlSheet2 As Excel.Worksheet

Private Sub Command1_Click()
On Error Resume Next
Dim i As Integer
Set ExlApp = CreateObject("Excel.Application")
Set ExlApp2 = ExlApp
If Err.Number <> 0 Then
Set ExlApp = GetObject("Excel.Application")
Set ExlApp2 = ExlApp
End If
On Error GoTo 0
Set ExlBook = ExlApp.Workbooks.Open("d:\demo1.xls")

For i = 1 To ExlBook.Sheets.Count
Set ExlSheet = ExlBook.Worksheets(i)
If ExlSheet.Name = "慧手并Sheet3" Then Exit For
Next i

ExlApp.DisplayAlerts = False
ExlApp2.DisplayAlerts = False

Set ExlBook2 = ExlApp2.Workbooks.Open("d:\demo2.xls")

For i = 1 To ExlBook2.Sheets.Count
Set ExlSheet2 = ExlBook2.Worksheets(i)
If ExlSheet2.Name = "Sheet2" Then
ExlSheet2.Delete
Exit For
End If
Next i

ExlSheet.Copy After:=ExlBook2.Sheets(1)

For i = 1 To ExlBook2.Sheets.Count
Set ExlSheet2 = ExlBook2.Worksheets(i)
If ExlSheet2.Name = "Sheet3" Then
ExlSheet2.Name = "Sheet2"
Exit For
End If
Next i

ExlBook2.Save
ExlApp.Quit
ExlApp2.Quit
Set ExlSheet = Nothing
Set ExlSheet2 = Nothing
Set ExlBook = Nothing
Set ExlBook2 = Nothing
Set ExlApp = Nothing
Set ExlApp2 = Nothing
End Sub

---

在瞎吵demo1.xls中插入模块，
在模磨滑侍块中复制以下让丛代码
Sub 复制sheet()

'先定义好 strPath
strPath = Workbooks("demo2.xls").Path
Application.Workbooks.Open strPath & "\demo2.xls"
Windows("demo1.xls").Activate
Sheets("Sheet3").Select
Sheets("Sheet3").Copy Before:=Workbooks("demo2.xls").Sheets(2)
'ActiveWindow.Close
End Sub

---

复制什么。。汇总吗？

---