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

a703130

請問各位前輩
我想將某一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

回復 1# a703130

1. Sub AA()
   
2. Sheets("Sheet(1)").[A1].CurrentRegion.Copy Sheets("Sheet(2)").[A1]
   
3. End Sub

複製代碼

a703130

回復 2# register313


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

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

register313

回復 3# a703130

何不執行看看就知道

CurrentRegion屬性 : 返回活動單元格所在的周圍由空行和空列組成的單元格區域(當前區域)

下載 (62.75 KB)

2012-3-8 10:22

a703130

回復 4# register313

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

sheet(1) 的資料

下載 (18.72 KB)

2012-3-8 10:33

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

下載 (19.12 KB)

2012-3-8 10:36

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

下載 (15.89 KB)
sheet(2)

2012-3-8 10:37

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

Hsieh

回復 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

回復 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

回復 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

複製代碼