|
こんな感じでしょーか。
Sub test2()
Dim Sh As Worksheet
Dim i As Long
Dim FileName As String, LkSt As String
Const FolderName As String = "\\C:test\"
Set Sh = ThisWorkbook.Worksheets("Sheet2")
Sh.Range("A:C").ClearContents
FileName = Dir(FolderName & "*.xls")
Do While FileName <> ""
i = i + 1
LkSt = "='" & FolderName & "[" & FileName & "]Sheet1'!"
Sh.Cells(i, 1).Formula = LkSt & "$B$3"
Sh.Cells(i, 2).Formula = LkSt & "$G$13"
Sh.Cells(i, 3).Formula = LkSt & "$J$18"
With Sh.Cells(i, 1).Resize(, 3)
.Value = .Value
End With
FileName = Dir()
Loop
Set Sh = Nothing: MsgBox "値の転記を終了しました", 64
End Sub
|
|