シート名に応じて新しいディレクトリに保存するVBA

Question

フォルダ内のすべてのファイルを開くコードを準備しようとしています。開いているファイル内のシートの名前を確認し、それを新しいフォルダに保存します。しかし、シート名が存在することを確認するIF文を追加しようとすると、このメソッドが存在しないことがわかります。誰かがより適切な方法を助言できますか？

Dim MyFile As String 
MyPath = "Q:\Folder Name1\Folder Name2\Folder Name3\Folder Name4\" 
MyFile = Dir(MyPath) 
Do While MyFile <> "" 
If MyFile Like "*.xlsx" Then 
Workbooks.Open MyPath & MyFile 

Dim ws1 As Worksheet 
Set ws1 = Sheets("Adult_Return") 

If ws1.Exists Then 

ChDir "Q:\Folder Name1\Folder Name2\Folder Name3\Folder Name4\Return" 
ActiveWorkbook.SaveAs Filename:=MyFile & ".xlsx" 

Else 

ChDir "Q:\Folder Name1\Folder Name2\Folder Name3\Folder Name4\Single" 
ActiveWorkbook.SaveAs Filename:=MyFile & ".xlsx" 

ありがとうございました。

Answer 1

関数を作成します：

Function SheetExists(wb As Workbook, sheetName As String) 

    Dim ws As Worksheet 
    SheetExists = False 
    For Each ws In wb.Sheets 
     If UCase(ws.Name) = UCase(sheetName) Then 
      SheetExists = True 
      Exit Function 
     End If 
    Next ws 

End Function 

はこのようにそれを呼び出します。

Dim wb As Workbook 
Set wb = Workbooks.Open(MyPath & MyFile) 
If SheetExists(wb, "Adult_Return") Then 
... 

ところで：あなただけの名前を付けて保存でパスを入れ、chdirを行う必要はありません。

wb.SaveAs "Q:\Folder Name1\Folder Name2\Folder Name3\Folder Name4\Single\" & MyFile & ".xlsx 

And：ブックを閉じることを忘れないでください！