Excel VBA質問箱 IV

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

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


749 / 75435 ←次へ | 前へ→

【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


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

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

76 hits

【80330】vba詳しい方、お力貸してください ミリヤ 19/1/25(金) 10:32 質問[未読]
【80333】Re:vba詳しい方、お力貸してください マナ 19/1/26(土) 0:44 発言[未読]
【80365】Re:vba詳しい方、お力貸してください ミリヤ 19/2/1(金) 16:36 発言[未読]
【80367】Re:vba詳しい方、お力貸してください マナ 19/2/1(金) 22:14 発言[未読]

749 / 75435 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free