麻辣家族討論版版 » Excel程式區 » 將工作頁的資料複製到另一工作頁(利用shift end)

返回列表下一主題上一主題發帖

[發問] 將工作頁的資料複製到另一工作頁(利用shift end)

中學生 Rank: 2

帖子: 97
主題: 32
精華: 0
積分: 167
點名: 0
作業系統: WinXP
軟體版本: Office2003
閱讀權限: 20
性別: 男
註冊時間: 2011-3-22
最後登錄: 2017-8-16

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2012-3-7 17:24 | 顯示全部帖子

[發問] 將工作頁的資料複製到另一工作頁(利用shift end)

請問各位前輩
我想將某一sheet(1)的資料複製到另一個sheet(2)上，最後統一在同一列上
但是每一列的資料範圍都會不同，但是起點都是一樣的
所以我利用以下方式，但是我卻不知道如何將所抓到的資料複製到sheet(2)上

sheet(1).select                                                                                        ' 選擇資料來源工作頁
iCount = Range("A3", Range("A3").End(xlToRight)).Count       '先抓共有多少列的資料
Range("A3").Select                                                                                  '先點選開始抓取的起點
For x = 1 To iCount
      Range(Cells(3, x), Cells(3, x).End(xlDown)).Select                   '選擇第一列的資料
      接下來應該是將上面抓取的資料複製sheet(2)
      當下一列資料抓到會接著複製下去
Next

我想知道的是如果是用我這方式是否可行，應該怎麼
另外也想知道是否有其他更淺顯易懂的方式

謝謝

樓主熱帖

收藏

中學生 Rank: 2

帖子: 97
主題: 32
精華: 0
積分: 167
點名: 0
作業系統: WinXP
軟體版本: Office2003
閱讀權限: 20
性別: 男
註冊時間: 2011-3-22
最後登錄: 2017-8-16

2^#

發表於 2012-3-8 09:48 | 顯示全部帖子

回復 2# register313

這樣不是只適用於sheet(1) 的資料都在同一列時嗎??

還是說 CurrentRegion 可以將sheet(1) 所有資料包含不同列全部選取後 copy 到 sheet(2)的同一列上嗎??

中學生 Rank: 2

帖子: 97
主題: 32
精華: 0
積分: 167
點名: 0
作業系統: WinXP
軟體版本: Office2003
閱讀權限: 20
性別: 男
註冊時間: 2011-3-22
最後登錄: 2017-8-16

3^#

發表於 2012-3-8 10:40 | 顯示全部帖子

回復 4# register313

抱歉大大，您可能沒搞懂我的問題

sheet(1) 的資料
未命名.JPG

未命名.JPG

我希望複製到sheet(2) 時，資料是這樣
因為每欄每列的資料數目不同所以我是利用count先計數來計算數量之後再貼上sheet(2)
而我再複製到sheet(2) 的地方卡住

而您上面所提供的方式
sheet(2) 仍會是這樣

是否有其他方式可以完成我上圖的結果??

中學生 Rank: 2

帖子: 97
主題: 32
精華: 0
積分: 167
點名: 0
作業系統: WinXP
軟體版本: Office2003
閱讀權限: 20
性別: 男
註冊時間: 2011-3-22
最後登錄: 2017-8-16

4^#

發表於 2012-3-8 11:10 | 顯示全部帖子

回復 6# Hsieh

謝謝各位前輩幫忙~我也額外學到兩種方式
下面是我剛剛所想到的~也一併分享

Sub test()
Sheets("1").Select
Dim iCount, iColumn, x, y As Integer
iCount = Range("A3", Range("A3").End(xlToRight)).Count
Range("A3").Select
y = 0
For x = 1 To iCount
Range(Cells(3, x), Cells(3, x).End(xlDown)).Select
iColumn = Range(Cells(3, x), Cells(3, x).End(xlDown)).Count
Selection.Copy Sheets("2").Cells(4 + y, 1)
y = y + iColumn
Next
End Sub

複製代碼

靜思自在 : 信心、毅力、勇氣三者具備，則天下沒有做不成的事。

返回列表下一主題上一主題