|
Dim Ad As String, C As Range '変数の宣言を追加
中略
Set ObjSht1 = ActiveWorkbook.ActiveSheet
ChDir "C:\"
buf2 = Application.GetOpenFilename("*.xls,*.xls")
If buf2 = "False" Then Exit Sub
WorkBooks.Open buf2
On Error GoTo ELine
With ActiveWorkbook.Worksheets("Sheet1")
Ad = .Range("A2", .Range("A65536").End(xlUp)).Address
End With
With ObjSht1.Range("A2", ObjSht1.Range("A65536").End(xlUp)).Offset(, 1)
.Formula = "=MATCH($A2,[" & Dir(buf2) & "]Sheet1!" & Ad & ",0)"
For Each C In .SpecialCells(3, 16)
ActiveWorkbook.Worksheets("Sheet1").Range("A65536") _
.End(xlUp).Offset(1).Value = C.Offset(, -1).Value
Next
.ClearContents
End With
ActiveWorkbook.Close True
Workbooks(2).Close False
概ねこんな感じでよいかと思います。
|
|