- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 0
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2024-11-14
|
如題
例如上圖為sheet1的資料
我想要複製上面兩列到sheet2
然後在將下面的值每五格取一個直到shee ...
yaya1986 發表於 2016-5-2 14:47  - Sub nn()
- Dim lSRow&, lTRow&
- Dim rTar As Range
- Dim wsTar As Worksheet
-
- Set wsTar = Sheets("Sheet2")
-
- With Sheets("Sheet1")
- wsTar.Cells.Clear
- .[A1:D2].Copy wsTar.[A1]
- lTRow = 7
- lSRow = 3
- Set rTar = .Cells(lTRow, 1)
- While rTar + rTar.Offset(, 1) + rTar.Offset(, 2) + rTar.Offset(, 3) <> 0
- rTar.Resize(, 4).Copy wsTar.Cells(lSRow, 1)
- lSRow = lSRow + 1
- lTRow = lTRow + 5
- Set rTar = .Cells(lTRow, 1)
- Wend
- End With
- End Sub
複製代碼
每隔5筆複製-a.zip (7.59 KB)
|
|