qwern

請問  Dear GBKEE  那如果我想要 他彙整的檔案不要有很多個分頁  全部都在同一個分頁  只是一直往下貼下去呢??

GBKEE

回復 11# qwern
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim MergePath As String, FS As String, Rng As Range
   
4.     MergePath = "D:\test\"                                      '合併檔案的資料夾
   
5.     FS = Dir(MergePath & "*.xls")                               '尋找 xls 檔案
   
6.     If FS <> "" Then
   
7.         Set Rng = Workbooks.Add(xlWBATWorksheet).Sheets(1).[a1] '新開的檔案(只有一張工作表)工作表的A1
   
8.         Application.ScreenUpdating = False
   
9.         Application.DisplayAlerts = False
   
10.         Do
    
11.             With Workbooks.Open(MergePath & FS)
    
12.                 .Sheets(1).UsedRange.Copy Rng                     'MergePath & 中工作表資料  複製到Rng
    
13.                 .Close
    
14.             End With
    
15.             FS = Dir                                              '繼續尋找(MergePath & "*.XLS")
    
16.             Set Rng = Rng.End(xlDown).Offset(1)                   '重設Rng 為往下到最後有資料的儲存格下一個空白之儲存格
    
17.         Loop While FS <> ""
    
18.         Application.DisplayAlerts = False
    
19.         Rng.Parent.Parent.SaveAs MergePath & "合併.xls"           '合併檔存檔
    
20.         Application.DisplayAlerts = True
    
21.         Application.ScreenUpdating = True
    
22.     Else
    
23.         MsgBox MergePath & " 沒有 xls 檔案"
    
24.     End If
    
25. End Sub

複製代碼

PS 按回覆鍵 你要回覆者會得到通知

leungko

回復 12# GBKEE


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

GBKEE

回復 13# leungko
MergePath = "D:\test\"                                      '合併檔案的資料夾:這裡 要有 副檔名為 xls 的EXCEL檔案
FS = Dir(MergePath & "*.xls")                             '尋找 xls 檔案

leungko

回復 14# GBKEE


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

GBKEE

回復 15# leungko

MergePath = "D:\test\"                                      '合併檔案的資料夾:這裡 要有 副檔名為 xls 的EXCEL檔案

紅色的路徑可修改為你中PC 有副檔名為 xls EXCEL檔案的資料夾

leungko

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
我已經修改了,,但是都不行...........

GBKEE

回復 17# leungko
再改一下試試看
MergePath = "C:\Documents and Settings\choikeun\Desktop\New\"                                      '合併檔案的資料夾

leungko

回復 18# GBKEE


    大大的感謝:victory:

lalalada

!!
太棒了
我本來整理csv檔是用複製然後開新分頁再貼上
結果會出現''資源不足...''的錯誤(大概是ram不夠?)
於是只好拆成兩個程式跑
我怎麼沒想到可以用複製分頁的m(_ _)m
感謝!!