Excel VBA質問箱 IV

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

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


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

2048 / 76734

←次へ　｜　前へ→


	【80330】vba詳しい方、お力貸してください

ミリヤ - 19/1/25(金) 10:32 -


	引用なし

	パスワード

下記マクロを組みました。

Sub 管理用ファイルをまとめて開く()
　　Dim keyword As String
　　Dim myPath As String
　　Dim fName As String

　　keyword = "管理用"
　　myPath = "C:\Users\user\Desktop\〇〇さんへ\管理用勤務表\"
　　fName = Dir(myPath & "*" & keyword & "*" & ".xlsx")

　　If fName = "" Then
　　　　MsgBox ("該当するファイルが存在しません。")
　　　　Exit Sub
　　End If

　　Do Until fName = ""
　　　　Shell ("explorer.exe " & myPath & fName)
　　　　fName = Dir()
　　Loop
　　
End Sub

Sub 勤務表ファイルをまとめて開く()
　　Dim keyword As String
　　Dim myPath As String
　　Dim fName As String

　　keyword = "勤務表"
　　myPath = "C:\Users\user\Desktop\〇〇さんへ\12月\"
　　fName = Dir(myPath & "*" & keyword & "*" & ".xlsx")

　　If fName = "" Then
　　　　MsgBox ("該当するファイルが存在しません。")
　　　　Exit Sub
　　End If

　　Do Until fName = ""
　　　　Shell ("explorer.exe " & myPath & fName)
　　　　fName = Dir()
　　Loop
　　
End Sub
Sub 対象ファイル同士のシートコピー()
'
' Macro2 Macro
'

'
　　Windows("2018年度勤務表_69〇〇.xlsx").Activate
　　Sheets("12月").Select
　　Sheets("12月").Copy Before:=Workbooks("【管理用】2018年度勤務表_69〇〇.xlsx").Sheets(11)
　　ActiveWorkbook.Save
　　ActiveWindow.Close
　　ActiveWindow.Close
End Sub

・上記をまず、一つのコードにしたいです。
（一気に処理できるように）
・シートのコピーは今はシート指定しているのですが、ファイルは複数ある為
〇〇部分が一致する者同士を自動でシートコピーさせたいです。

お力貸していただけませんでしょうか。
宜しくお願いします。

7 hits

▼

【80330】vba詳しい方、お力貸してください ミリヤ 19/1/25(金) 10:32