Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

14755 / 76734

←次へ　｜　前へ→


	【67468】Re:MsgBoxで指定したブックのデータをコピーしたい

kanabun - 10/12/7(火) 13:16 -


	引用なし

	パスワード

先程の

>　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

1 hits

▼

【67465】MsgBoxで指定したブックのデータをコピーしたい すず 10/12/7(火) 0:14