|
こんばんは
シート名「様式3-3(1)」が「Sheet1」とかでしたら「ExecuteExcel4Macro」が使える
と思うのですが、
Sub test()
Dim motoSheet As String
Dim wSh As Worksheet
Dim mSh As Worksheet
Dim sDataR
Dim i As Long
Dim r As Range
Dim rr As Range
Dim sFol As String
motoSheet = "様式3-3(1)"
Set mSh = ThisWorkbook.Sheets("Sheet1")
sDataR = Array("Q1", "W5", "X1", "E12", "R15")
With mSh
Application.ScreenUpdating = False
sFol = ThisWorkbook.Path
Set rr = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
For Each r In rr
On Error Resume Next
Set wSh = Workbooks.Open(sFol & "\" & r.Value).Worksheets(motoSheet)
On Error GoTo 0
If Not wSh Is Nothing Then
For i = LBound(sDataR) To UBound(sDataR)
r.Offset(, i + 1).Value = wSh.Range(sDataR(i))
Next i
End If
wSh.Parent.Close False
Set wSh = Nothing
Next
Application.ScreenUpdating = True
End With
Set mSh = Nothing: Set rr = Nothing
End Sub
|
|