| |
▼Ｇ一朗 さん：
もう１つ。 転記先ブックが複数ありうる場合のコード案です。
処理の最初に転記先ブック名で並び替えをします。
Sample3と同じく、転記先ブックのみを開きます。
Sub Sample4()
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")
.Cells.Sort key1:=Columns("D"), order1:=xlAscending, header:=xlYes
For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
If Not done Then
Set wb3 = Workbooks.Open(c.Offset(, 3).Value)
done = True
End If
w = Split(c.Value, "\")
fName = w(UBound(w))
myPath = Left(c.Value, Len(c.Value) - Len(fName))
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
If c.Offset(, 3).Value <> c.Offset(1, 3).Value Then wb3.Close True
Next
End With
Set wb3 = Nothing
Application.ScreenUpdating = True
MsgBox "処理が終了しました"
End Sub
|
|
UO3
- 12/3/23(金) 14:47 -
