合併一個excel內的幾個worksheet的內容在另一個excel內的一個worksheet內

198188

合併3個EXCEL.rar (18.97 KB)

下載次數: 5

2012-11-18 11:00

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

回復 3# 198188


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

198188

回復 2# Hsieh


    請問如果將幾個不同的excel合併可以嗎？這個只是將一個excel的不同worksheet合併。但不同的excel我就想不到，怎樣解決？

Hsieh

回復 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

複製代碼