Set WB = Workbooks.Open(Filename:=filefolder & "まとめ.xlsx")でファイルが存在しませんとエラーが発生します。確かにこのフォルダーに存在するファイルなのですが。。。スペルミスも確認しましたが見当たりません。
またもう一点、Dirで返すファイル名の条件分けは変換する前のファイル名に数字は入っていないのでIf InStr(openname, "1234567890") というコードに変更して実行しました。結果コードは問題なく実行されましたが、私が欲しかったファイル名を変更したものではコードを実行しないという条件が満たされませんでした。
どなたかコードで改善点が見当たる方、またエラー解決への手順を教えてくださる方がいれば嬉しいです。よろしくお願いします。
Sub north_snow() Dim Mstr As String Dim filefolder As String Dim openname As String Dim orgShCnt As Long, iCnt As Long filefolder = "\\rfs\EC_INTL\Common\IEC\DATA\TB\01_RDC\" Set WB = Workbooks.Open(Filename:=filefolder & "まとめ.xlsx") openname = Dir(filefolder & "*.xls?") Do Until openname = "" If InStr(openname, "_") <> 0 Then openname = Dir() Else If openname <> ThisWorkbook.Name And openname <> "まとめ.xlsx" And openname Like "*-*" Then Set CB = Workbooks.Open(Filename:=filefolder & openname) CB.Worksheets(CB.Worksheets.Count).Copy after:=WB.Worksheets(WB.Worksheets.Count) CB.Close savechanges:=False Mstr = Replace(openname, ".xlsx", "") Mstr = Format(DateValue(Mid(Mstr, InStr(Mstr, "-") + 1, 3) & "/1"), "yyyy_mm") & openname Name filefolder & openname As filefolder & Mstr End If End If openname = Dir() Loop Application.DisplayAlerts = False WB.Sheets(1).Delete Application.DisplayAlerts = True WB.Save WB.Close Set CB = Nothing Set WB = Nothing End Sub

バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2017/09/25 05:54