- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 31# jackson7015 - Option Explicit
- Sub Ex()
- Dim E As Variant, wbSh(1 To 2) As Worksheet, bNFind(1 To 2) As Boolean
- Dim AR(1 To 2), xPath As String, Rng As Range
- AR(1) = "全年度資料庫.xls" '檔案名稱
- AR(2) = "當月報表.xls" '檔案名稱
- xPath = "D:\" '檔案的路徑
- For Each E In Workbooks '所有開啟的活頁簿物件集合
- If E.Name = AR(1) Then bNFind(1) = True '全年度資料庫 已開啟
- If E.Name = AR(2) Then bNFind(2) = True '當月報表 已開啟
- Next
- For E = 1 To UBound(bNFind)
- If Not bNFind(E) Then '檔案未開啟
- Workbooks.Open (xPath & AR(E))
- End If
- Set wbSh(E) = Workbooks(AR(E)).Sheets("綜合資料庫")
- Next
- With wbSh(2) '當月報表"中的[綜合資料庫]
- '***1.因AQ有時候會沒有設定值，所以能否只判斷A列有幾行，然後複製A5:AQ(A列最後一行)
- 'Set Rng = .Cells(.Rows.Count, .[AQ1].Column).End(xlUp) ' 找末列
- Set Rng = .Cells(.Rows.Count, "AQ").End(xlUp) ' 找末列
- If .[A5].End(xlDown).Row > Rng.Row Then
- Set Rng = .Range(.[A5], .Range("AQ" & .[A5].End(xlDown).Row))
- Else
- Set Rng = .Range(.[A5], Rng)
- End If
- End With
- With wbSh(1) '全年度資料庫"資料表的[綜合資料庫]
- Rng.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
- '***3.只貼上"值"的部分就好
- .UsedRange = .UsedRange.Value
- End With
- '***2.只儲存關閉"全年度資料庫"
- Workbooks(AR(1)).Close True '全年度資料庫. 關閉且存檔
- End Sub
|
|
發表於 2015-5-12 15:48
| 