Excel VBA質問箱 IV

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

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


122 / 13339 ツリー ←次へ | 前へ→

【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 発言[未読]

【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


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

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

【80333】Re:vba詳しい方、お力貸してください
発言  マナ  - 19/1/26(土) 0:44 -

引用なし
パスワード
   ▼ミリヤ さん:

>上記をまず、一つのコードにしたいです。

1人分だけコピーするなら
こんな感じでできませんか。


Sub test()
  Dim myPath As String
  Dim fName As String
  Dim wb勤務 As Workbook
  Dim wb管理 As Workbook

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

  myPath = "C:\Users\user\Desktop\〇〇さんへ\管理用勤務表\"
  Set wb管理 = Workbooks.Open(myPath & "【管理用】" & fName)

  wb勤務.Sheets("12月").Copy Before:=wb管理.Sheets(11)
  
  wb勤務.Close False
  wb管理.Close True

End Sub

 

【80365】Re:vba詳しい方、お力貸してください
発言  ミリヤ  - 19/2/1(金) 16:36 -

引用なし
パスワード
   ▼マナ さん:
一人分だけならうまくいきました!!!
これを複数ファイルにおこないたいのですが。。
何かいい方法はないでしょうか。

【80367】Re:vba詳しい方、お力貸してください
発言  マナ  - 19/2/1(金) 22:14 -

引用なし
パスワード
   ▼ミリヤ さん:

>一人分だけならうまくいきました!!!

コードを理解できていますか?
ちょっと違いますが、このあたりを参考になります。
ht tps://www.moug.net/tech/exvba/0060003.html

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