Board logo

標題: [發問] 如何取得sheet1每一欄的資料每隔5筆複製到sheet2 [打印本頁]
作者: yaya1986    時間: 2016-5-2 14:47     標題: 如何取得sheet1每一欄的資料每隔5筆複製到sheet2

如題

[attach]24139[/attach]

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

[attach]24138[/attach]

VBA新手 一直失敗只能執行到第二欄就停止...
作者: luhpro    時間: 2016-5-2 21:53

如題
例如上圖為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
複製代碼
[attach]24145[/attach]
作者: yaya1986    時間: 2016-5-3 06:33

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

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

我好像權限不夠 無法下載壓縮檔
作者: 准提部林    時間: 2016-5-3 10:46

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    時間: 2016-5-3 11:27



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



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