| |
▼Ｇ一朗 さん：
質問の回答をもらっていない段階ですが、コード案を３つ。
Sample1 は、アップされた方式、１行ごとにファイルを開いて転記するタイプ。
ただし、この場合、２行目が、また同じファイルかもしれません。
そうすると、同じブックを二度開こうとしてエラーになります。
ですので、毎回開いて、保存して閉じるということをしなければいけません。
Sample2 は 転記元ブックと転記先ブックが、それぞれ１つというタイプ。
最初の行でのみ、転記元ブックと転記先ブックを開きます。
さらに、Sample3は、Sample2の別案。開くファイルは転記先ブックのみです。
Sub Sample1()
Dim c As Range
Dim d As Variant
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Sheet1")
For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
Workbooks.Open c.Value
d = ActiveWorkbook.Sheets(c.Offset(, 1).Value).Range(c.Offset(, 2).Value).Value
ActiveWorkbook.Close False
Workbooks.Open c.Offset(, 3).Value
ActiveWorkbook.Sheets(c.Offset(, 4).Value).Range(c.Offset(, 5).Value).Value = d
ActiveWorkbook.Close True
Next
End With
Application.ScreenUpdating = True
MsgBox "処理が終了しました"
End Sub
Sub Sample2()
Dim c As Range
Dim d As Variant
Dim done As Boolean
Dim wb2 As Workbook, wb3 As Workbook
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Sheet1")
For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
If Not done Then
Set wb2 = Workbooks.Open(c.Value)
Set wb3 = Workbooks.Open(c.Offset(, 3).Value)
done = True
End If
wb3.Sheets(c.Offset(, 4).Value).Range(c.Offset(, 5).Value).Value = _
wb2.Sheets(c.Offset(, 1).Value).Range(c.Offset(, 2).Value).Value
Next
End With
wb2.Close False
wb3.Close True
Set wb2 = Nothing
Set wb3 = Nothing
Application.ScreenUpdating = True
MsgBox "処理が終了しました"
End Sub
Sub Sample3()
Dim c As Range
Dim d As Variant
Dim done As Boolean
Dim wb3 As Workbook
Dim myPath As String
Dim fName As String
Dim w As Variant
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Sheet1")
For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
If Not done Then
Set wb3 = Workbooks.Open(c.Offset(, 3).Value)
w = Split(c.Value, "\")
fName = w(UBound(w))
myPath = Left(c.Value, Len(c.Value) - Len(fName))
done = True
End If
With wb3.Sheets(c.Offset(, 4).Value).Range(c.Offset(, 5).Value)
.Formula = "='" & myPath & "[" & fName & "]" & c.Offset(, 1).Value & "'!" & c.Offset(, 2).Value
.Value = .Value
End With
Next
End With
wb3.Close True
Set wb3 = Nothing
Application.ScreenUpdating = True
MsgBox "処理が終了しました"
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
