請教EXCEL合併 - Excel程式區 - 麻辣家族討論版版

帖子: 12
主題: 3
精華: 0
積分: 53
點名: 0
作業系統: xp
軟體版本: off 2003
閱讀權限: 20
註冊時間: 2012-7-4
最後登錄: 2023-5-12

1^# 跳轉到 »

發表於 2012-7-18 20:50 | 顯示全部帖子

回復 12# GBKEE

我用了,但是都是說沒有 xls 檔案?{:2_26:}

帖子: 12
主題: 3
精華: 0
積分: 53
點名: 0
作業系統: xp
軟體版本: off 2003
閱讀權限: 20
註冊時間: 2012-7-4
最後登錄: 2023-5-12

2^#

發表於 2012-7-20 13:20 | 顯示全部帖子

回復 14# GBKEE

大大師兄.........可能是我笨......做了好多次都是不行..我是用2003.....{:2_38:}

帖子: 12
主題: 3
精華: 0
積分: 53
點名: 0
作業系統: xp
軟體版本: off 2003
閱讀權限: 20
註冊時間: 2012-7-4
最後登錄: 2023-5-12

3^#

發表於 2012-7-23 16:43 | 顯示全部帖子

Sub Ex()
Dim MergePath As String, FS As String, Rng As Range
MergePath = "C:\Documents and Settings\choikeun\Desktop\New"                                     '合併檔案的資料夾
FS = Dir(MergePath & "*.xls")                            '尋找 xls 檔案
If FS <> "" Then
      Set Rng = Workbooks.Add(xlWBATWorksheet).Sheets(1).[a1] '新開的檔案(只有一張工作表)工作表的A1
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      Do
         With Workbooks.Open(MergePath & FS)
            .Sheets(1).UsedRange.Copy Rng                   'MergePath & 中工作表資料  複製到Rng
            .Close
         End With
         FS = Dir                                           '繼續尋找(MergePath & "*.XLS")
         Set Rng = Rng.End(xlDown).Offset(1)                '重設Rng 為往下到最後有資料的儲存格下一個空白之儲存格
      Loop While FS <> ""
      Application.DisplayAlerts = False
      Rng.Parent.Parent.SaveAs MergePath & "合併.xls"          '合併檔存檔
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
Else
      MsgBox MergePath & " 沒有 xls 檔案"
End If
End Sub
我已經修改了,,但是都不行...........

帖子: 12
主題: 3
精華: 0
積分: 53
點名: 0
作業系統: xp
軟體版本: off 2003
閱讀權限: 20
註冊時間: 2012-7-4
最後登錄: 2023-5-12

4^#

發表於 2012-7-25 13:13 | 顯示全部帖子

回復 18# GBKEE

大大的感謝:victory:

doraemon1.gif (127.23 KB)