[發問] 指定檔案 抓去個檔案間資料

ounmaxz

小弟目前需整理很多人工時問題希望從[工時整理]檔內匯入
M1~M16的檔案內容排序方式為
M1檔匯至A1起始
M2檔匯至A1000起始
M3檔匯至A2000起始
一直排到M14 16000起始
各M檔內A1~AA1000 資料都須複製到工時整理]檔內
希望只要按一檔案內按鈕九可以抓取M1~M14黨內資料不需一個一個開啟
拜託各位大大幫忙


新資料夾.rar (933.3 KB)

下載次數: 15

2011-11-22 16:57

ounmaxz

回復 1# ounmaxz


    ub 巨集1()
'
' 巨集1 巨集
'

'
    Workbooks.Open Filename:="Q:\M1.xlsx"
    Range("A4:X400").Select
    Selection.Copy
    Windows("工時整理.xlsm").Activate
    Range("A3").Select
    ActiveSheet.Paste
    Windows("M1.xlsx").Activate
    ActiveWindow.Close
   
    Workbooks.Open Filename:="Q:\M2.xlsx"
    Range("A4:W400").Select
    Selection.Copy
    Windows("工時整理.xlsm").Activate
    Range("A400").Select
    ActiveSheet.Paste
    Windows("M2.xlsx").Activate
    ActiveWindow.Close

小弟我用錄製的手法做出來了但是
會一直出現剪貼簿要我選擇要不要清空他
因為檔案很多一直按很麻煩有辦法解決嗎???

ounmaxz

回復 3# GBKEE


    感謝大大的幫忙
   但是因為檔名世人名故用M1來替代
    如果使用此程式會造成無法讀取資料
   是否可在抓取的主檔EXCEL直接寫入路徑及檔名
   再去抓取所要的資料

ounmaxz

回復 9# GBKEE


    可指定抓取M1   A4:AD400資料
    工時紀錄檔內將追隨前一筆資料中間不要留空白表格嗎???

ounmaxz

回復 11# GBKEE


    使用後兩種路徑選擇模式都顯示10004錯誤無法開啟檔案
    目前檔案室放在網路連線的磁碟內
    我使用錄製的路徑來做為索引的路徑
    套用到大大的程式裡卻找不到
    是我路徑選定有問題嗎

附上使用路徑
Q:\4A00維護課\內部控管\維修工時報工管理\2012年\M1.xlsx

ounmaxz

回復 14# GBKEE

上傳圖片比較容易說明
請看~~

   

下載 (87.35 KB)

2011-11-24 13:16

下載 (97.79 KB)

2011-11-24 13:16

以下程式碼是我用錄製的執行上OK

Workbooks.Open Filename:="Q:\4A00維護課\內部控管\維修工時報工管理\2012年\M1.xlsx"
    Range("A4:AD400").Select
    Selection.Copy
    Windows("123.xlsm").Activate
    Range("A3").Select
    ActiveSheet.Paste
    Windows("M1.xlsx").Activate
    ActiveWindow.Close

ounmaxz

回復 16# GBKEE


    感謝大大不厭其煩地幫忙
   目前測試已能正常運作
    被路徑跟檔名套的團團轉:L

ounmaxz

回復 16# GBKEE


    目前使用上都沒有問題
只是螢幕會一直閃一直閃
能夠在程式執行時停止更新螢幕嗎
執行完再更新螢幕
不然一直閃眼睛好痛

Sub Ex()
    Dim Rng As Range, NameRng As Range, CopyRng As Range, E As Range
    Set NameRng = Workbooks("工時整理.xlsm").Sheets(5).[A2:A20].SpecialCells(xlCellTypeConstants)   '人名的範圍 或是 完整的路徑檔案名稱
    Set Rng = Workbooks("工時整理.xlsm").Sheets(1).[a3]
    For Each E In NameRng
        'With Workbooks.Open("Q:\" & E & ".xlsx")  'E=人名
        With Workbooks.Open(E)   '如 E = 完整的路徑檔案名稱
            Set CopyRng = .Sheets(1).UsedRange.Offset(3)
            Rng.Resize(CopyRng.Rows.Count, CopyRng.Columns.Count).Value = CopyRng.Value
            If Rng.End(xlDown).Row = Rows.Count Then
                Set Rng = Rng.End(xlDown).End(xlUp).Offset(1)
            Else
                Set Rng = Rng.End(xlDown).Offset(1)
            End If
            .Close False
        End With
    Next
End Sub

ounmaxz

回復 19# GBKEE


    感謝GBKEE 大大的幫忙謝謝