返回列表 上一主題 發帖

[發問] 關於依指定儲存格值儲存至另一檔案的指定位置..

不確定你的版本是否適用, 副檔名 ".xls" 自行更改:

  1. Sub TEST()
  2. Dim A As Range, B As Range, N%
  3. Dim X As New Application, FN$, xB As Workbook
  4. For Each A In [F4:G4]
  5.     N = N + 1
  6.     FN = ThisWorkbook.Path & "\" & A.Value & ".xls"
  7.     If Dir(FN) = "" Then GoTo 101
  8.     Set xB = X.Workbooks.Open(FN)
  9. For Each B In [E5:E14]
  10.     On Error Resume Next
  11.     If Range(B.Value) Is Nothing Then GoTo 102
  12.     On Error GoTo 0
  13.     xB.Sheets(1).Range(B).Value = B(1, N + 1)
  14. 102: Next
  15.     xB.Close 1
  16. 101: Next
  17. End Sub
複製代碼

TOP

        靜思自在 : 知識要用心體會,才能變成自己的智慧。
返回列表 上一主題