1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2012-4-9 15:57 | 只看該作者

不同活頁簿資料彙整

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

請教各位高手~我想把壓縮檔裡的S1、S2及S3的三個檔案裡的部分儲存格~複製下來並貼到另外一個新的檔案(S-total)，這樣的VBA語法範本該怎麼寫才好~求高手指點

5^#

發表於 2012-4-12 09:49 | 只看該作者

感謝GBKEE高手~

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

4^#

發表於 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

複製代碼

3^#

發表於 2012-4-10 09:04 | 只看該作者

感謝GBKEE高手~那再請教您另外一個問題~ 壓縮檔裡的S1、S2及S3的三個檔案~我只想要複製我所需要的儲存格(由Title A到TitleB)貼到另外一個新的檔案(S-total)，~但是儲存格x是我不需要複製的~這樣該怎麼寫比較好呢?

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

2^#

發表於 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

複製代碼