Board logo

標題: [發問] 將工作頁的資料複製到另一工作頁(利用shift end) [打印本頁]
作者: a703130    時間: 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

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

謝謝
作者: register313    時間: 2012-3-7 17:54

回復 1# a703130
  1. Sub AA()
  2. Sheets("Sheet(1)").[A1].CurrentRegion.Copy Sheets("Sheet(2)").[A1]
  3. End Sub
複製代碼
作者: a703130    時間: 2012-3-8 09:48

回復 2# register313


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

還是說  CurrentRegion  可以將sheet(1) 所有資料  包含不同列  全部選取後  copy 到 sheet(2)的同一列上嗎??
作者: register313    時間: 2012-3-8 10:21

本帖最後由 register313 於 2012-3-8 10:22 編輯

回復 3# a703130

何不執行看看就知道

CurrentRegion屬性 : 返回活動單元格所在的周圍由空行和空列組成的單元格區域(當前區域)
[attach]9906[/attach]
作者: a703130    時間: 2012-3-8 10:40

回復 4# register313

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

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

而您上面所提供的方式
sheet(2) 仍會是這樣
[attach]9910[/attach]
   
是否有其他方式可以完成我上圖的結果??
作者: Hsieh    時間: 2012-3-8 11:03

回復 5# a703130
  1. Sub nn()
  2. With Sheet1
  3. Set ar = .[A3].CurrentRegion
  4. For i = 1 To ar.Columns.Count
  5.    Application.Index(ar, , i).Copy Sheet2.[A65536].End(xlUp).Offset(1)
  6. Next
  7. End With
  8. End Sub
複製代碼
作者: register313    時間: 2012-3-8 11:09

回復 5# a703130
用你一開始的方法去修改
  1. Sub XX()
  2. Sheets("Sheet(2)").Cells = ""
  3. Sheets("Sheet(1)").Select
  4. With Sheets("Sheet(1)")
  5.   iCount = .Range("A3", Range("A3").End(xlToRight)).Count
  6.   For X = 1 To iCount
  7.     If X = 1 Then
  8.       .Range(Cells(3, X), Cells(3, X).End(xlDown)).Copy Sheets("Sheet(2)").[A4]
  9.     Else
  10.       .Range(Cells(3, X), Cells(3, X).End(xlDown)).Copy Sheets("Sheet(2)").[A65536].End(xlUp).Offset(1, 0)
  11.     End If
  12.   Next
  13. End With
  14. End Sub
複製代碼
作者: a703130    時間: 2012-3-8 11:10

回復 6# Hsieh

謝謝各位前輩幫忙~我也額外學到兩種方式
下面是我剛剛所想到的~也一併分享
  1. Sub test()
  2.     Sheets("1").Select
  3.     Dim iCount, iColumn, x, y As Integer
  4.     iCount = Range("A3", Range("A3").End(xlToRight)).Count
  5.     Range("A3").Select
  6.     y = 0
  7.     For x = 1 To iCount
  8.         Range(Cells(3, x), Cells(3, x).End(xlDown)).Select
  9.         iColumn = Range(Cells(3, x), Cells(3, x).End(xlDown)).Count
  10.         Selection.Copy Sheets("2").Cells(4 + y, 1)
  11.         y = y + iColumn
  12.     Next
  13. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)