返回列表 上一主題 發帖

[發問] VBA 複製data問題(跨Sheet)

iamaraymond
　暱稱: Raymond Chien

中學生Rank: 2

帖子
109 
主題
12 
精華
0 
積分
177 
點名
0  
作業系統
win10 
軟體版本
office2013 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2017-11-19 
最後登錄
2023-7-5 
1# 跳轉到 »
發表於 2018-4-18 09:29 | 顯示全部帖子
回復 4# dea172

這應該是因為你沒有同時把這兩個檔案打開，如果你想只打開IPQC就執行程式的話
  1. Sub TEST()
  2. Dim Arr, Brr(1 To 2, 1 To 39), i&, j%, xE As Range
  3. Arr = [A4:J15]
  4. Brr(1, 1) = Split([G2], "-")(0) & "-FQC3"
  5. Brr(2, 1) = Split([G2], "-")(0) & "-FQC2"
  6. Brr(1, 2) = Year([C1]): Brr(2, 2) = Year([C1])
  7. Brr(1, 3) = [C1]: Brr(2, 3) = [C1]
  8. Brr(1, 4) = [L4]: Brr(2, 4) = [L4]
  9. For i = 0 To UBound(Arr) - 1
  10.     If Arr(i + 1, 1) <> "M1" Then
  11.        For j = 5 To 7: Brr(1, i * 3 + j) = Arr(i + 1, j + 1): Next j
  12.        For j = 5 To 6: Brr(2, i * 3 + j) = Arr(i + 1, j + 4): Next j
  13.     Else
  14.        For j = 5 To 6: Brr(1, i * 3 + j) = Arr(i + 1, j + 1): Next j
  15.     End If
  16. Next i
  17. Workbooks.Open Filename:="C:\Users\User\Downloads\VBA-Test\FQC.xls"
  18. Set xE = Workbooks("FQC").Sheets("input").[A65536].End(xlUp)(2)
  19. If xE.Row < 6 Then Set xE = xE(2)
  20. xE.Resize(2, 39) = Brr

  22. Workbooks("FQC").Close 1
  23. End Sub
複製代碼
把Workbooks.Open Filename改成你的路徑就好
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

        靜思自在 : 道德是提昇自我的明燈，不該是呵斥別人的鞭子。
返回列表 上一主題