Board logo

標題: 合併一個excel內的幾個worksheet的內容在另一個excel內的一個worksheet內 [打印本頁]
作者: 198188    時間: 2012-11-18 11:01     標題: 合併一個excel內的幾個worksheet的內容在另一個excel內的一個worksheet內

[attach]13188[/attach]
Private Sub cmdMerge_Click()
    Dim a, b, c As Integer '宣告A,B,C為整數
    Dim objsheet As Worksheet
   
    Source = Excel.ActiveWorkbook.Name '新檔案視窗編號   
   
    n = Range("b3")
    m = Range("b4")
   
    hmerger = UCase(Range("b5")) '是否為水平合併   
     '將之前合併的結果清除
    Sheet2.Range("A:AB").Clear
   
    z = 1
    i = 1
   
    Filename1 = Range("b" & 6) & "." & Range("b2")
    Filename2 = Range("b" & 7) & "." & Range("b2")
    Filename3 = Range("b" & 8) & "." & Range("b2")
   
    Workbooks.Open Filename:=Excel.Workbooks(Source).Path & "\" & Filename1
    Workbooks.Open Filename:=Excel.Workbooks(Source).Path & "\" & Filename2
    Workbooks.Open Filename:=Excel.Workbooks(Source).Path & "\" & Filename3
   
    WorkName = Excel.ActiveWorkbook.Name '
作者: Hsieh    時間: 2012-11-18 12:11

回復 1# 198188
  1. Private Sub cmdMerge_Click()
  2. Dim wb As Workbook, msh As Worksheet, mxsh As Worksheet, fs As String, sh, Tr As Range
  3. Application.ScreenUpdating = False
  4. fd = ThisWorkbook.Path & "\" '檔案目錄"
  5. Set msh = ThisWorkbook.Sheets("參數設定")
  6. Set mxsh = ThisWorkbook.Sheets("合併結果")
  7. fs = fd & msh.[B1] & "." & msh.[B2]
  8. If Dir(fs) = "" Then MsgBox "檔案目錄錯誤請檢查": Exit Sub
  9. mxsh.Cells.Clear
  10. Set wb = Workbooks.Open(fs)
  11.   For Each sh In msh.Range(msh.[B6], msh.[B6].End(xlDown))
  12.      With wb.Sheets(CStr(sh))
  13.      If Tr Is Nothing Then Set Tr = .Range(.[A1], .[A1].End(xlToRight)): Tr.Copy mxsh.[A1]
  14.         .Range("A1").CurrentRegion.Offset(msh.[B4], msh.[B3] - 1).Copy mxsh.[A65536].End(xlUp).Offset(1)
  15.      End With
  16.   Next
  17. wb.Close 0
  18. MsgBox "合併完成"
  19. Application.ScreenUpdating = True
  20. End Sub
複製代碼
作者: 198188    時間: 2012-11-19 23:36

回復 2# Hsieh


    請問如果將幾個不同的excel合併可以嗎？這個只是將一個excel的不同worksheet合併。但不同的excel我就想不到，怎樣解決？
作者: Hsieh    時間: 2012-11-20 08:27

回復 3# 198188


    workbooks.open主要是filename引數的取得
filename是活頁簿的路徑包含檔案名稱所組成的字串
想想如何得到此字串是解決問題的根本
論壇中此類文章甚多可以參考



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)