返回列表 上一主題 發帖

[發問] 可否不用打開B.xls,C.xls就可進行sheets(1)匯出 匯入

回復 1# yangjie
2.    Application.EnableEvents = False
  1. Sub Test()
  2.   Dim wb1 As Workbook, wb2 As Workbook
  3.   
  4.   Application.EnableEvents = False
  5.   Application.ScreenUpdating = False
  6.   Application.DisplayAlerts = False
  7.   
  8.   Set wb1 = Workbooks.Open("C:\B.xls")
  9.   Set wb2 = Workbooks.Open("C:\C.xls")
  10.   wb1.Sheets(Array("sheet1", "sheet2", "sheet3")).Copy After:=wb2.Sheets(wb2.Sheets.Count)
  11.   wb1.Close False
  12.   wb2.Close True
  13.   
  14.   Application.DisplayAlerts = True
  15.   Application.ScreenUpdating = True
  16.   Application.EnableEvents = True
  17. End Sub
複製代碼
1

評分人數

    • GBKEE: 精品文章金錢 + 2

TOP

回復 3# yangjie
  1. Sub Test()
  2.   Dim wb1 As Workbook, wb2 As Workbook
  3.   Dim s
  4.   
  5.   Application.EnableEvents = False
  6.   Application.ScreenUpdating = False
  7.   Application.DisplayAlerts = False
  8.   
  9.   Set wb1 = Workbooks.Open("C:\B.xls")
  10.   Set wb2 = Workbooks.Open("C:\C.xls")
  11.   
  12.   On Error GoTo ERR_HANDLE
  13.     For Each s In Array("sheet1", "sheet2", "sheet3")
  14.       wb1.Sheets(s).Copy After:=wb2.Sheets(wb2.Sheets.Count)
  15.     Next s
  16.   On Error GoTo 0
  17.   
  18.   wb1.Close False
  19.   wb2.Close True
  20.   
  21.   Application.DisplayAlerts = True
  22.   Application.ScreenUpdating = True
  23.   Application.EnableEvents = True
  24.   Exit Sub
  25.    
  26. ERR_HANDLE:
  27.   '忽略(陣列索引超出範圍)錯誤
  28.   If Err.Number = 9 Then Resume Next
  29.   
  30.   'Other Error
  31.   Debug.Print "Error :" & Err.Number & Chr(13) & Err.Description
  32.   Stop
  33. End Sub
複製代碼

TOP

本帖最後由 stillfish00 於 2013-9-26 10:58 編輯

回復 4# yangjie
我執行後,若 wb已有sheet1, sheet3, 會複製成 sheet1 (1)、sheet3 (1),原本就不會覆蓋資料了,不曉得備份是甚麼用意?

TOP

本帖最後由 stillfish00 於 2013-9-26 14:56 編輯

回復 8# yangjie
這樣其實是不好的更新方法,但是要你重新把VBA與資料部分分開又不太現實,8# 的code 可以把
  1.             For j = 1 To wb.Sheets.Count
  2.                 If wb.Sheets(j).Name = wb1.Sheets(i).Name Then
  3.                     wb.Sheets(j).Copy After:=wb.Sheets(wb.Sheets.Count)
  4.                     wb.Sheets(j).Delete
  5.                     Exit For
  6.                 End If
  7.             Next
  8.             wb1.Sheets(i).Copy After:=wb.Sheets(wb.Sheets.Count)
複製代碼
改成下面試看看(依4#所說更名,copy 改 move...反正wb1不儲存)
  1.             For j = 1 To wb.Sheets.Count
  2.                 If wb.Sheets(j).Name = wb1.Sheets(i).Name Then
  3.                     wb.Sheets(j).Name = wb.Sheets(j).Name & "_old"
  4.                     Exit For
  5.                 End If
  6.             Next
  7.             wb1.Sheets(i).Move After:=wb.Sheets(wb.Sheets.Count)
複製代碼

TOP

        靜思自在 : 人生不一定球球是好球,但是有歷練的強打者,隨時都可以揮棒。
返回列表 上一主題