[[20230502101207]] 『特定のシートを削除し、マクロブックをxlsxで保存』(たくぼく) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『特定のシートを削除し、マクロブックをxlsxで保存したい』(たくぼく)

あるフォルダ配下にあるファイル(xlsm)の特定のワークシート(シート名A、シート名B)のみを削除して、さらにファイルをxlsxの拡張子に変更した状態で保存させたいです。
ファイルは数十程度あり、それぞれ違うネームで同一フォルダに入っています。
よろしくお願いいたします。

< 使用 Excel:Microsoft365、使用 OS:Windows11 >


マクロブックのマクロはどのモジュールに記述されているのでしょう?
(とおりすがりんご) 2023/05/02(火) 10:33:58

 こんな感じで行けると思うけど、すでにファイルがある場合、上書き保存できない。
    Option Explicit
    Const strDelSheetA As String = "Sheet1"
    Const strDelSheetB As String = "Sheet2"
    Const myPath As String = "C:\test\"
    Sub テスト()
        Dim files() As String
        Dim f As Variant
        Dim wb As Workbook
        Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
        files = GetFiles(myPath, "xls*")
        If (Not Not files) = 0 Then Exit Sub
        For Each f In files
            Set wb = Workbooks.Open(f, False, True)
            Application.DisplayAlerts = False
            On Error Resume Next
            wb.Sheets(strDelSheetA).Delete
            wb.Sheets(strDelSheetB).Delete
            wb.SaveAs wb.Path & "\" & fso.getBaseName(wb.FullName) & ".xlsx", xlWorkbookDefault
            On Error GoTo 0
            wb.Close False
            Application.DisplayAlerts = True
            'Kill wb.FullName
        Next f
        MsgBox "完了しました"
    End Sub
    Function GetFiles(pt As String, ext As String) As String()
        Dim cnt As Long
        Dim f As String
        Dim files() As String
        cnt = -1
        f = Dir(pt & "*" & ext)
        Do Until f = ""
            cnt = cnt + 1
            ReDim Preserve files(cnt)
            files(cnt) = pt & f
            f = Dir()
        Loop
        GetFiles = files
    End Function

(稲葉) 2023/05/02(火) 11:11:00


既にコメントがあるようですが2点ほど。

■1
>よろしくお願いいたします。
これは"質問"でしょうか?
質問であるなら現状のコードを示したうえで、以下を踏まえて具体的にどこで詰まっているか説明できないでしょうか?

 1)エラーが発生する場合
  「発生個所・エラー番号・エラーメッセージなど」の提示

 2)エラーは発生しないが思った通りにならない場合
  ××になるはずが○○になるのような説明

質問でなく作成依頼をしたいということならば、その旨明示しておいた方がお互いの気持ちがすれ違わなくてよいと思います。

■2
作成依頼ではないが、アプローチの着想がないのでそこを"質問"したいということならば

 1. [あるフォルダ配下]を巡回して[あるファイル(xlsm)]だったら開く
 2. ↑のブックのうち[特定のワークシート(シート名A、シート名B)]以外を新規ブックへコピーする
 3. ↑を名前を付けて【xlsx形式】で保存する
 4. ↑を閉じる
 5. 2〜4を繰り返し

というアプローチで考えてみてはどうでしょうか?

(もこな2 ) 2023/05/02(火) 11:25:03


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.