[發問] 如何取得sheet1每一欄的資料每隔5筆複製到sheet2

yaya1986

如題

下載 (26.01 KB)

2016-5-2 14:46

例如上圖為sheet1的資料
我想要複製上面兩列到sheet2
然後在將下面的值每五格取一個直到sheet2
執行到最後一列最後一欄如下圖
每次資料可能列數或欄數不同
該怎麼寫呢...?

下載 (12.22 KB)

2016-5-2 14:46

VBA新手 一直失敗只能執行到第二欄就停止...

luhpro

如題
例如上圖為sheet1的資料
我想要複製上面兩列到sheet2
然後在將下面的值每五格取一個直到shee ...
yaya1986 發表於 2016-5-2 14:47

1. Sub nn()
   
2.   Dim lSRow&, lTRow&
   
3.   Dim rTar As Range
   
4.   Dim wsTar As Worksheet
   
5.   
   
6.   Set wsTar = Sheets("Sheet2")
   
7.   
   
8.   With Sheets("Sheet1")
   
9.     wsTar.Cells.Clear
   
10.     .[A1:D2].Copy wsTar.[A1]
    
11.     lTRow = 7
    
12.     lSRow = 3
    
13.     Set rTar = .Cells(lTRow, 1)
    
14.     While rTar + rTar.Offset(, 1) + rTar.Offset(, 2) + rTar.Offset(, 3) <> 0
    
15.       rTar.Resize(, 4).Copy wsTar.Cells(lSRow, 1)
    
16.       lSRow = lSRow + 1
    
17.       lTRow = lTRow + 5
    
18.       Set rTar = .Cells(lTRow, 1)
    
19.     Wend
    
20.   End With
    
21. End Sub

複製代碼

每隔5筆複製-a.zip (7.59 KB)

下載次數: 4

2016-5-2 21:53

yaya1986

感謝!!!目前這樣資料數執行沒有問題

但每次可能資料數不同也有可能會A:X都有資料
這個執行後只能執行a欄到d欄 看巨集是寫[A12]
是否可以用End()的指令

我好像權限不夠 無法下載壓縮檔

准提部林

Sub TEST()
Dim R&, i&, xH As Range
Sheets("Sheet2").UsedRange.Clear
Set xH = [Sheet2!A1]
With Sheets("Sheet1")
　　　.[1:2].Copy xH
　　　Set xH = xH(3)
　　　For i = 7 To .UsedRange.Rows.Count Step 5
　　　　　.Rows(i).Copy xH
　　　　　Set xH = xH(2)
　　　Next
End With
End Sub

yaya1986

成功了!!謝謝~
而且執行起來很快!!