【マクロ・VBA マクロコード公開】Sheetの並び替えマクロ

アイキャッチ画像 sheet間

Sheetの並び替えマクロを紹介します

マクロコードも紹介しています

使用方法解説動画↓

こんな時に使えます↓

同僚が作ったエクセルファイルやお得意さまから送られたファイル

いくつものSheetがあり整理されてなくて仕事の効率が落ちるからSheetの整理をします

けどエクセルにはSheetの並び替え(ソート)機能がないから、手作業で並び替えして「無駄作業~」ってなるけど作業を効率化させるために渋々やる

そんなときに一瞬でSheetの並び替えをしてくれるマクロを作りました

このマクロを使って、1分でも早く仕事を終わらせましょう

目指せ定時退社!

※並び替えは「あいうえお順」にはできません

数字やアルファベット順に対応しています

マクロコード

※マクロを入れる場合、EXCELファイルをマクロ形式にしてください

その後、Alt+F11でマクロの画面に移り変わるので、Alt+I+Mを押して

表示した画面にコピペしてください

下の記事にマクロの取り込み方法をまとめたのでよかったら参考にしてください

Sub Sheet並び替え()
'変数/////////////////////////////////
Dim wb As Workbook: Set wb = ThisWorkbook

Dim ws_sum As Long 'Sheetの合計変数

Dim ws_name1 As String 'Sheet名1用変数

Dim ws_name2 As String 'Sheet名2用変数

Dim sort_count '並び変える回数用変数

Dim i As Long 'カウンター変数

Dim msg As Long 'メッセージBOX用変数

'昇順・降順の確認/////////////////////////
msg = MsgBox("[はい]=昇順" & vbCrLf & vbCrLf & "[いいえ]=降順", vbYesNoCancel) 'msgboxの回答を変数に代入

ws_sum = wb.Sheets.Count 'Sheets数をカウント

If msg = 6 Then '[はい]=昇順

'Sheet昇順sort////////////////////////////
    Do While sort_count <> ws_sum 'Sheet数と同じ回数分ループ処理
    
        For i = 1 To ws_sum - 1
        
            ws_name1 = wb.Sheets(i).Name 'Sheet名を代入
            
            ws_name2 = wb.Sheets(i + 1).Name '該当の隣のSheet名を代入
        
            If ws_name1 > ws_name2 Then 'Sheet名の比較
            
                wb.Sheets(i).Move After:=wb.Sheets(i + 1) 'Sheetの移動
            
            End If
        
        Next i
    
        sort_count = sort_count + 1 'ソートした回数をプラス
        
    Loop

ElseIf msg = 7 Then '[いいえ]=降順
'Sheet降順sort////////////////////////////
    Do While sort_count <> ws_sum
    
        For i = 1 To ws_sum - 1
        
            ws_name1 = wb.Sheets(i).Name 'Sheet名を代入
            
            ws_name2 = wb.Sheets(i + 1).Name '該当の隣のSheet名を代入
        
            If ws_name1 < ws_name2 Then 'Sheet名の比較
            
                wb.Sheets(i).Move After:=wb.Sheets(i + 1) 'Sheetの移動
            
            End If
        
        Next i
    
        sort_count = sort_count + 1 'ソートした回数をプラス
        
    Loop

End If

End Sub

コメント

タイトルとURLをコピーしました