|
先程の
> For i = 0 To UBound(FoundFiles)
> Debug.Print FoundFiles(i)
> Next
のなかに すこし加筆してみました。
Sub ファイル取得ボタン_Click()
(省 略)
''検索パスとファイルパターンを指定してファイル検索
FoundFiles = GetFile(myPath, FileName)
If UBound(FoundFiles) < 0 Then
MsgBox "該当ファイルが見つかりません"
Exit Sub
End If
Dim WB0 As Workbook
Set WB0 = Workbooks("コピー先Book.xls")
Dim WB As Workbook
Dim ws As Worksheet
For i = 0 To UBound(FoundFiles)
Set WB = Workbooks.Open(FoundFiles(i))
For Each ws In WB.Worksheets
Select Case ws.Name
Case "東京", "大阪", "名古屋"
このシートより転記 ws, WB0
End Select
Next
WB.Close False
Set WB = Nothing
Next
Set WB0 = Nothing
MsgBox "転記終了!"
End Sub
> A101206.xlsの「東京」シートのA1〜C10の範囲で、
> 最終行以外(つまりA1〜C9まで)を、
> C101206シートの「東京」シートD1を基点に貼り付ける、
> データの行数が可変し、最終行以外を貼り付ける、という
> ところがポイントになります。
Private Sub このシートより転記( _
ByVal ws As Worksheet, _
ByVal WB0 As Workbook)
Dim ws0 As Worksheet
Set ws0 = WB0.Worksheets(ws.Name)
Dim r As Range
With ws
Set r = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
Set r = r.Resize(r.Rows.Count - 1, 3)
End With
r.Copy ws0.Range("D1")
End Sub
|
|