不同活頁簿資料彙整

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

1^# 跳轉到 »

發表於 2012-4-9 17:07 | 顯示全部帖子

本帖最後由 GBKEE 於 2012-4-9 17:11 編輯

回復 1# mankind0703
壓縮檔的活頁簿是開啟的程式碼

Option Explicit
Sub Ex()
Dim Rng As Range, Wbo As Workbook
Set Rng = Workbooks("s-total.xlsx").Sheets("sheet1").[a1] 's-total.xlsx 沒資料
'Set Rng = Workbooks("s-total.xlsx").Sheets("sheet1").[a1].End(xlDown).Offset(1) 's-total.xlsx 資料連續往下複製
For Each Wbo In Workbooks
If Wbo.Name <> Rng.Parent.Parent.Name Then 'Rng是儲存格 :的父層(為工作表)的父層(為活頁簿)
Wbo.Sheets("Sheet1").Range("A:A").SpecialCells(xlCellTypeConstants).CurrentRegion.Copy Rng
'範圍: Wbo:各活頁簿.Sheets("工作表").Range("A欄" ).SpecialCells(xlCellTypeConstants)(有資料).CurrentRegion(目前區域是指以任意空白列及空白欄的組合為邊界的範圍)
'範圍.Copy(複製) (空一格)Rng(範圍)
Set Rng = Rng.End(xlDown).Offset(1)
'Rng 範圍.End(xlDown:"往下") 到最後有資料的儲存格
'範圍.Offset (位移列數,位移欄數) '將範圍移動到指定區域的範圍
End If
Next
End Sub

複製代碼

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2012-4-10 11:25 | 顯示全部帖子

回復 3# mankind0703

Option Explicit
Sub Ex()
Dim Rng As Range, Wbo As Workbook
Set Rng = Workbooks("s-total.xlsx").Sheets("sheet1").[a1] 's-total.xlsx 沒資料
'Set Rng = Workbooks("s-total.xlsx").Sheets("sheet1").[a1].End(xlDown).Offset(1) 's-total.xlsx 資料連續往下複製
For Each Wbo In Workbooks
If Wbo.Name <> Rng.Parent.Parent.Name Then 'Rng是儲存格 :的父層(為工作表)的父層(為活頁簿)
Wbo.Sheets("Sheet1").Range("A:A").SpecialCells(xlCellTypeConstants).CurrentRegion.Copy Rng
'範圍: Wbo:各活頁簿.Sheets("工作表").Range("A欄" ).SpecialCells(xlCellTypeConstants)(有資料).CurrentRegion(目前區域是指以任意空白列及空白欄的組合為邊界的範圍)
'範圍.Copy(複製) (空一格)Rng(範圍)
Set Rng = Rng.End(xlDown).Offset(1)
'Rng 範圍.End(xlDown:"往下") 到最後有資料的儲存格
'範圍.Offset (位移列數,位移欄數) '將範圍移動到指定區域的範圍
End If
Next
With Workbooks("s-total.xlsx").Sheets("sheet1").Cells
.Replace "x", "=100/1", xlWhole '複製後將: x 字串替換為公式
.SpecialCells(xlCellTypeFormulas).Delete '刪除有公式的儲存格
End With
End Sub

複製代碼

靜思自在 : 【時間無法遮擋】怕時間消逝，花了許多心血，想盡各式方法要遮擋時間，結果是：浪費了更多時間，且一無所成！