| |
こんにちは
A10:A12→結合
B10:B12→結合
C10:I12→結合
と考えて。
記載シートはA〜E列まで使います。
A〜C列は転記データ、D列にファイル名、E列にシート名を記載します。
E列のシート名にハイパーリンクを設定します。（該当シートが開きます）
Const strPath As String = "\\NetPc\C\Test\" '実際のパス名に変更
上記を実際のパス名に変更してお試しを。
Sub test03()
Dim strFileName As String, Sh As Worksheet, wbkSource As Workbook
Const strPath As String = "\\NetPc\C\Test\" '実際のパス名に変更
strFileName = Dir(strPath, vbNormal)
If strFileName = "" Then Exit Sub
Application.ScreenUpdating = False
With ThisWorkbook.ActiveSheet
.Range("A1:E1").EntireColumn.Clear
Do Until strFileName = ""
Set wbkSource = Workbooks.Open(strPath & strFileName)
For Each Sh In wbkSource.Worksheets
With .Cells(.Rows.Count, 1).End(xlUp)
.Offset(1, 3).Resize(, 2).Value = Array(strFileName, Sh.Name)
ActiveSheet.Hyperlinks.Add Anchor:=.Offset(1, 4), Address:= _
strPath & strFileName & "#" & Sh.Name & "!A1"
.Offset(1).Value = Sh.Range("A10:A10").Cells(1).Value
.Offset(1, 1).Value = Sh.Range("B10:B12").Cells(1).Value
.Offset(1, 2).Value = Sh.Range("C10:I12").Cells(1).Value
End With
Next Sh
wbkSource.Close False
strFileName = Dir()
Loop
End With
Application.ScreenUpdating = True
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
