Excel VBAマクロ入門｜コピペで使えるサンプルコード30選

Excel VBAマクロとは、Excelの操作をVBA（Visual Basic for Applications）というプログラミング言語で書いて自動化するしくみです。 「最終行まで計算する」「条件に合う行だけ別シートに写す」「シートごとにファイルを分ける」といった繰り返し作業を、ボタン1つで終わらせられます。

この記事は、マクロの保存と実行の手順 → 最終行・最終列の取得4通り → ループ3種の使い分け → 用途別のサンプル30本 → 実行時エラーの早見表までを1ページで読める入門ガイドです。コードはすべて Option Explicit・変数の型宣言・On Error つきの同じ形にそろえてあるので、どれを貼っても読み方が変わりません。

確認環境：コードで使うオブジェクト・メソッド・プロパティの名前、引数名、定数の値は、Microsoft Learn の Excel VBA リファレンス（原稿は GitHub の MicrosoftDocs/VBA-Docs で公開）の2026-10-05時点の記載と1つずつ照合しました。この記事のコードは、リファレンスの記載との照合で確かめたもので、画面の出力例は載せていません。お手元のブックで試すときは、コピーしたファイルで動かしてください。

Excel VBAサンプルコード30本の早見表

サンプルは、シート名が「注文」で、1行目に見出し（A列から順に 注文ID・日付・担当・商品・分類・数量・単価・金額・備考）、2行目からデータが入っている表を前提にしています。シート名や列の位置は、お手元の表に合わせて書き換えてください。

マクロの保存と実行の手順

手順1：開発タブを表示する

VBA を書く画面（Visual Basic Editor）は、リボンの「開発」タブから開きます。開発タブは最初は表示されていないので、次の手順で表示します（Microsoft Learn「Getting started with VBA in Office」の手順）。

1. 「ファイル」タブの「オプション」を開く
2. 左側の「リボンのユーザー設定」を選ぶ
3. 右側の「メイン タブ」の一覧で「開発」にチェックを入れる
4. 「OK」を選ぶ

手順2：標準モジュールにコードを貼る

1. 開発タブの「Visual Basic」ボタンで Visual Basic Editor を開く
2. 「挿入」メニューの「標準モジュール」を選ぶ（新しい標準モジュールがプロジェクトに追加されます）
3. 開いたコードの画面に、この記事のコードを貼り付ける

Option Explicit はモジュールの先頭に1回だけ書きます。2本目以降のサンプルを同じモジュールに貼るときは、Sub から End Sub までを追加してください。

手順3：実行する

（Microsoft サポート「Run a macro in Excel」の手順）

手順4：マクロ有効ブックとして保存する

マクロは、通常の拡張子のファイルには保存できない決まりになっています（Microsoft Learn「Getting started with VBA in Office」）。Excel では、マクロ有効ブック（拡張子 .xlsm）として保存します。VBA からファイル形式を指定するときの定数は次のとおりです。

.xlsm のファイルを開いたとき、セキュリティの設定によってはマクロが無効の状態で開きます。設定は Office の「トラスト センター」で確認できます。

コードの共通ルール（Option Explicit・型宣言・On Error）

30本のサンプルは、次のひな形に沿って書いています。

Option Explicit

Sub Template()
    Dim ws As Worksheet      ' 変数は必ず型を付けて宣言する
    Dim lastRow As Long

    On Error GoTo ErrHandler ' エラーが起きたら ErrHandler へ進む

    Set ws = ThisWorkbook.Worksheets("注文")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' ここに処理を書く

    Exit Sub                 ' 正常に終わったらここで抜ける
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

On Error には3つの形があります。

最終行・最終列を取得する4通りと違い

「データが何行目まであるか」は、ほとんどのマクロで最初に求める値です。よく使う4通りを1つのコードにまとめました。

Option Explicit

Sub ShowLastRowAndColumn()
    Dim ws As Worksheet
    Dim rowByEnd As Long, colByEnd As Long
    Dim rowByUsed As Long, colByUsed As Long
    Dim rowByRegion As Long, colByRegion As Long
    Dim rowByFind As Long, colByFind As Long
    Dim found As Range

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")

    ' 1) End(xlUp)：A列のいちばん下のセルから上へ進んで最初に当たるセル
    rowByEnd = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    colByEnd = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    ' 2) UsedRange：シートで使われている範囲の右下
    With ws.UsedRange
        rowByUsed = .Row + .Rows.Count - 1
        colByUsed = .Column + .Columns.Count - 1
    End With

    ' 3) CurrentRegion：A1 を含む、空白行と空白列で囲まれたかたまり
    With ws.Range("A1").CurrentRegion
        rowByRegion = .Row + .Rows.Count - 1
        colByRegion = .Column + .Columns.Count - 1
    End With

    ' 4) Find：シート全体を後ろ向きに探して最初に見つかるセル
    Set found = ws.Cells.Find(What:="*", After:=ws.Range("A1"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not found Is Nothing Then rowByFind = found.Row

    Set found = ws.Cells.Find(What:="*", After:=ws.Range("A1"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
    If Not found Is Nothing Then colByFind = found.Column

    MsgBox "End: " & rowByEnd & "行 / " & colByEnd & "列" & vbCrLf & _
           "UsedRange: " & rowByUsed & "行 / " & colByUsed & "列" & vbCrLf & _
           "CurrentRegion: " & rowByRegion & "行 / " & colByRegion & "列" & vbCrLf & _
           "Find: " & rowByFind & "行 / " & colByFind & "列", vbInformation
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

定義から読み取れる違いを、1つの例で比べます。A〜C列の1〜6行目に表があり、7行目が空白行、8行目のA列にメモ、9行目はC列だけに値がある、というシートの場合です。

迷ったら End(xlUp) を「必ず入力される列」に対して使うのが基本です。定数の値は xlUp が -4162、xlToLeft が -4159、xlDown が -4121、xlToRight が -4161 です。

For・For Each・Do Loopの使い分け

同じ「数量の合計」を3通りで書くと、次のようになります。

Option Explicit

Sub LoopThreeWays()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim c As Range
    Dim total1 As Double, total2 As Double, total3 As Double

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' For...Next：行番号で回す
    For i = 2 To lastRow
        total1 = total1 + ws.Cells(i, 6).Value
    Next i

    ' For Each...Next：セルの集まりを1つずつ
    For Each c In ws.Range("F2:F" & lastRow)
        total2 = total2 + c.Value
    Next c

    ' Do While...Loop：A列が空になるまで
    i = 2
    Do While ws.Cells(i, 1).Value <> ""
        total3 = total3 + ws.Cells(i, 6).Value
        i = i + 1
    Loop

    MsgBox "For: " & total1 & " / For Each: " & total2 & " / Do Loop: " & total3, vbInformation
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

行を削除しながら回すときは、For i = lastRow To 2 Step -1 のように下から上へ進めます。上から進めると、削除で行が詰まったぶん、次の行を飛ばしてしまうためです（サンプル4）。

セルと表を操作するサンプル（No.1〜15）

1. セルに値と数式を書く

Option Explicit

Sub Sample01_WriteValues()
    Dim ws As Worksheet

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")

    ws.Range("K1").Value = "合計"                 ' セル番地で指定
    ws.Cells(1, 12).Formula = "=SUM(H2:H11)"      ' 行番号, 列番号で指定（L1）
    ws.Range("K2:L2").Value = "確認済み"           ' 範囲にまとめて同じ値
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

Range("K1") は番地、Cells(行, 列) は番号で指定します。ループの中では番号で指定できる Cells が便利です。

2. 最終行まで1行ずつ計算する

Option Explicit

Sub Sample02_CalcEachRow()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastRow
        ws.Cells(i, 8).Value = ws.Cells(i, 6).Value * ws.Cells(i, 7).Value  ' 金額 = 数量 × 単価
    Next i
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description & "（" & i & "行目）", vbExclamation
End Sub

エラーメッセージに行番号 i を入れておくと、どの行のデータで止まったかがすぐわかります。

3. 条件に合う行に色を付ける

Option Explicit

Sub Sample03_ColorRows()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastRow
        If ws.Cells(i, 6).Value >= 20 Then
            ws.Range(ws.Cells(i, 1), ws.Cells(i, 9)).Interior.Color = RGB(255, 242, 204)
        End If
    Next i
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

色は RGB(赤, 緑, 青) 関数で作った値を Interior.Color に入れます。

4. 空白行を下から削除する

Option Explicit

Sub Sample04_DeleteBlankRows()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    With ws.UsedRange
        lastRow = .Row + .Rows.Count - 1
    End With

    For i = lastRow To 2 Step -1          ' 下から上へ
        If Application.WorksheetFunction.CountA(ws.Rows(i)) = 0 Then
            ws.Rows(i).Delete
        End If
    Next i
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

CountA は空でないセルの数を返すので、0 なら行全体が空です。空白行をまたいで調べるため、最終行は UsedRange から求めています。

5. 重複する行を削除する

Option Explicit

Sub Sample05_RemoveDuplicates()
    Dim ws As Worksheet

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")

    ' 3列目（担当）と4列目（商品）の組み合わせが同じ行を1件にする
    ws.Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(3, 4), Header:=xlYes
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

Columns には、重複を判定する列の番号を配列で渡します。Header の既定値は xlNo なので、見出しがある表では xlYes を必ず指定します。

6. 表を並べ替える

Option Explicit

Sub Sample06_SortTable()
    Dim ws As Worksheet

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")

    ' 金額（H列）の大きい順
    ws.Range("A1").CurrentRegion.Sort Key1:=ws.Range("H1"), Order1:=xlDescending, Header:=xlYes
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

Order1 は xlAscending（値は 1、昇順、既定）か xlDescending（値は 2、降順）です。

7. フィルターで絞って別シートに写す

Option Explicit

Sub Sample07_FilterAndCopy()
    Dim ws As Worksheet, wsOut As Worksheet
    Dim tbl As Range

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    Set wsOut = ThisWorkbook.Worksheets("抽出")
    Set tbl = ws.Range("A1").CurrentRegion

    If ws.AutoFilterMode Then ws.AutoFilterMode = False   ' 前のフィルターを外す
    tbl.AutoFilter Field:=3, Criteria1:="佐藤"            ' 3列目（担当）が佐藤

    wsOut.Cells.ClearContents
    tbl.SpecialCells(xlCellTypeVisible).Copy Destination:=wsOut.Range("A1")

    ws.AutoFilterMode = False
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

Field は表の左端を1とした列の番号です。SpecialCells(xlCellTypeVisible) で見えているセルだけを取り出しています。写し先の「抽出」シートは先に作っておきます（サンプル16で自動化できます）。

8. 値だけ貼り付ける

Option Explicit

Sub Sample08_PasteValues()
    Dim ws As Worksheet, wsOut As Worksheet

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    Set wsOut = ThisWorkbook.Worksheets("抽出")

    ws.Range("A1").CurrentRegion.Copy
    wsOut.Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False     ' コピー中の点線の枠を消す
    Exit Sub
ErrHandler:
    Application.CutCopyMode = False
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

xlPasteValues（値は -4163）は値だけ、xlPasteFormats（-4122）は書式だけを貼り付けます。

9. 見出しを太字にして罫線と列幅を整える

Option Explicit

Sub Sample09_FormatTable()
    Dim ws As Worksheet
    Dim tbl As Range

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    Set tbl = ws.Range("A1").CurrentRegion

    tbl.Rows(1).Font.Bold = True
    tbl.Rows(1).Interior.Color = RGB(221, 235, 247)
    tbl.Borders.LineStyle = xlContinuous
    tbl.EntireColumn.AutoFit
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

AutoFit は、行全体か列全体の範囲に対して使う決まりです。そのため tbl.EntireColumn で列全体に広げてから呼んでいます。

10. 日付と数値の表示形式をそろえる

Option Explicit

Sub Sample10_NumberFormat()
    Dim ws As Worksheet
    Dim lastRow As Long

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    If lastRow < 2 Then Exit Sub

    ws.Range("B2:B" & lastRow).NumberFormatLocal = "yyyy/m/d"
    ws.Range("F2:H" & lastRow).NumberFormatLocal = "#,##0"
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

NumberFormatLocal には、Excel の画面で使っている言語の表示形式コードを文字列で指定します。

11. 文字を検索して見つかったセルをすべて調べる

Option Explicit

Sub Sample11_FindAll()
    Dim ws As Worksheet
    Dim target As Range, found As Range
    Dim firstAddress As String
    Dim result As String

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    Set target = ws.Range("A1").CurrentRegion

    Set found = target.Find(What:="ペン", LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

    If found Is Nothing Then
        MsgBox "見つかりませんでした。", vbInformation
        Exit Sub
    End If

    firstAddress = found.Address
    Do
        result = result & found.Address & vbCrLf
        Set found = target.FindNext(found)
        If found Is Nothing Then Exit Do
    Loop While found.Address <> firstAddress

    MsgBox result, vbInformation
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

Find は見つからないと Nothing を返します。If found Is Nothing の判定を必ず入れるのが、実行時エラー91を防ぐ決まった形です。検索は範囲の終わりまで行くと先頭に戻るので、最初に見つかったセルの番地を覚えておき、同じ番地に戻ったら終わりにします。

12. 文字を一括で置き換える

Option Explicit

Sub Sample12_ReplaceText()
    Dim ws As Worksheet
    Dim lastRow As Long

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    If lastRow < 2 Then Exit Sub

    ws.Range("D2:D" & lastRow).Replace What:="ペン", Replacement:="ボールペン", _
        LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

LookAt:=xlWhole（値は 1）はセルの内容全体が一致する場合だけ、xlPart（値は 2）は一部が一致する場合も対象にします。

13. 配列でまとめて読み書きする

Option Explicit

Sub Sample13_ArrayReadWrite()
    Dim ws As Worksheet
    Dim lastRow As Long, n As Long, i As Long
    Dim src As Variant
    Dim result() As Variant

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    n = lastRow - 1
    If n < 2 Then Exit Sub                       ' データが2行以上あるときだけ

    src = ws.Range("F2:G" & lastRow).Value       ' 2次元配列（1 To n, 1 To 2）で受け取る
    ReDim result(1 To n, 1 To 1)

    For i = 1 To n
        result(i, 1) = src(i, 1) * src(i, 2)     ' 数量 × 単価
    Next i

    ws.Range("H2").Resize(n, 1).Value = result   ' 1回でまとめて書き込む
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

複数のセルからなる範囲の Value は、セルの値が入った2次元配列を返します。逆に、2次元配列を Value に代入すると1回の操作で範囲に書き込まれます。行数が多い表では、サンプル2のようにセルを1つずつ読み書きするより、この形が向いています。

14. 担当ごとの合計を別シートに出す

Option Explicit

Sub Sample14_SumByPerson()
    Dim ws As Worksheet, wsOut As Worksheet
    Dim dict As Object
    Dim lastRow As Long, i As Long, r As Long
    Dim person As String
    Dim key As Variant

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    Set wsOut = ThisWorkbook.Worksheets("集計")
    Set dict = CreateObject("Scripting.Dictionary")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastRow
        person = ws.Cells(i, 3).Value
        If dict.Exists(person) Then
            dict(person) = dict(person) + ws.Cells(i, 8).Value
        Else
            dict.Add person, ws.Cells(i, 8).Value
        End If
    Next i

    wsOut.Cells.ClearContents
    wsOut.Range("A1").Value = "担当"
    wsOut.Range("B1").Value = "金額合計"
    r = 2
    For Each key In dict.Keys
        wsOut.Cells(r, 1).Value = key
        wsOut.Cells(r, 2).Value = dict(key)
        r = r + 1
    Next key
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

Dictionary は「キー」と「値」の組を覚えておく入れ物です。Exists でキーがあるかを調べ、なければ Add で追加、あれば値を足し込みます。

15. ワークシート関数を VBA から使う

Option Explicit

Sub Sample15_UseSumIf()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim total As Double

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    If lastRow < 2 Then Exit Sub

    total = Application.WorksheetFunction.SumIf( _
        ws.Range("C2:C" & lastRow), "佐藤", ws.Range("H2:H" & lastRow))

    MsgBox "佐藤さんの金額合計：" & Format(total, "#,##0"), vbInformation
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

Application.WorksheetFunction の後ろに関数名を続けると、SUMIF や COUNTA などのワークシート関数を VBA の中で呼べます。

シートを操作するサンプル（No.16〜20）

16. シートが無ければ追加する

Option Explicit

Sub Sample16_AddSheetIfMissing()
    Dim wb As Workbook
    Dim ws As Worksheet
    Const SHEET_NAME As String = "抽出"

    On Error GoTo ErrHandler
    Set wb = ThisWorkbook

    If Not SheetExists(wb, SHEET_NAME) Then
        Set ws = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
        ws.Name = SHEET_NAME
    End If
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

Function SheetExists(ByVal wb As Workbook, ByVal sheetName As String) As Boolean
    Dim ws As Worksheet

    On Error Resume Next            ' 無いシートを指定するとエラー9になることを判定に使う
    Set ws = wb.Worksheets(sheetName)
    On Error GoTo 0

    SheetExists = Not ws Is Nothing
End Function

SheetExists は、ほかのサンプルの前準備としても使い回せます。On Error Resume Next の区間は、このように判定に必要な1行だけにとどめます。

17. シートをコピーして日付入りの名前を付ける

Option Explicit

Sub Sample17_CopySheetWithDate()
    Dim wb As Workbook
    Dim ws As Worksheet, wsNew As Worksheet

    On Error GoTo ErrHandler
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("注文")

    ws.Copy After:=wb.Sheets(wb.Sheets.Count)        ' いちばん後ろにコピー
    Set wsNew = wb.Sheets(wb.Sheets.Count)
    wsNew.Name = "注文_" & Format(Date, "yyyymmdd")
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

同じ日に2回実行すると、同じ名前のシートがすでにあるため名前の変更でエラーになり、メッセージが表示されます。

18. すべてのシート名を一覧にする

Option Explicit

Sub Sample18_ListSheetNames()
    Dim wb As Workbook
    Dim sh As Worksheet, wsOut As Worksheet
    Dim r As Long

    On Error GoTo ErrHandler
    Set wb = ThisWorkbook
    Set wsOut = wb.Worksheets("目次")

    wsOut.Cells.ClearContents
    wsOut.Range("A1").Value = "シート名"
    r = 2
    For Each sh In wb.Worksheets
        wsOut.Cells(r, 1).Value = sh.Name
        r = r + 1
    Next sh
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

19. 確認メッセージなしでシートを削除する

Option Explicit

Sub Sample19_DeleteSheetQuietly()
    Dim wb As Workbook

    On Error GoTo ErrHandler
    Set wb = ThisWorkbook

    Application.DisplayAlerts = False
    wb.Worksheets("抽出").Delete
    Application.DisplayAlerts = True
    Exit Sub
ErrHandler:
    Application.DisplayAlerts = True
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

シートの Delete は、既定では削除を確認するダイアログを表示します。Application.DisplayAlerts を False にすると表示されません。エラーで止まった場合も True に戻すよう、ErrHandler の中にも同じ行を書いています。

20. シートごとに別のブックとして保存する

Option Explicit

Sub Sample20_SaveEachSheetAsBook()
    Dim wb As Workbook, wbNew As Workbook
    Dim sh As Worksheet
    Dim folderPath As String

    On Error GoTo ErrHandler
    Set wb = ThisWorkbook
    folderPath = wb.Path & Application.PathSeparator

    Application.ScreenUpdating = False
    For Each sh In wb.Worksheets
        sh.Copy                                   ' 引数なしのコピーは新しいブックを作る
        Set wbNew = ActiveWorkbook
        wbNew.SaveAs Filename:=folderPath & sh.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
        wbNew.Close SaveChanges:=False
    Next sh
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    Application.ScreenUpdating = True
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

Worksheet.Copy に Before も After も指定しないと、コピーしたシート1枚だけを持つ新しいブックが作られ、それがアクティブなブックになります。

ブックとファイルを操作するサンプル（No.21〜26）

21. 別のブックを開いて値を写す

Option Explicit

Sub Sample21_ImportFromBook()
    Dim wbSrc As Workbook
    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim srcPath As String

    On Error GoTo ErrHandler
    srcPath = ThisWorkbook.Path & Application.PathSeparator & "data.xlsx"
    Set wsDst = ThisWorkbook.Worksheets("取込")

    Set wbSrc = Workbooks.Open(Filename:=srcPath, ReadOnly:=True)
    Set wsSrc = wbSrc.Worksheets(1)

    wsDst.Cells.ClearContents
    wsSrc.Range("A1").CurrentRegion.Copy Destination:=wsDst.Range("A1")

    wbSrc.Close SaveChanges:=False
    Exit Sub
ErrHandler:
    If Not wbSrc Is Nothing Then wbSrc.Close SaveChanges:=False
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

Workbooks.Open は開いたブックを表す Workbook オブジェクトを返すので、Set で変数に受け取ってから操作します。読むだけのときは ReadOnly:=True で開きます。

22. フォルダー内のブックを順番に処理する

Option Explicit

Sub Sample22_LoopFilesInFolder()
    Dim folderPath As String, fileName As String
    Dim wbSrc As Workbook
    Dim wsOut As Worksheet
    Dim r As Long

    On Error GoTo ErrHandler
    folderPath = ThisWorkbook.Path & Application.PathSeparator & "input" & Application.PathSeparator
    Set wsOut = ThisWorkbook.Worksheets("一覧")
    wsOut.Cells.ClearContents
    wsOut.Range("A1").Value = "ファイル名"
    wsOut.Range("B1").Value = "A1の値"
    r = 2

    Application.ScreenUpdating = False
    fileName = Dir(folderPath & "*.xlsx")        ' 最初の1件
    Do While fileName <> ""
        Set wbSrc = Workbooks.Open(Filename:=folderPath & fileName, ReadOnly:=True)
        wsOut.Cells(r, 1).Value = fileName
        wsOut.Cells(r, 2).Value = wbSrc.Worksheets(1).Range("A1").Value
        wbSrc.Close SaveChanges:=False
        Set wbSrc = Nothing
        r = r + 1
        fileName = Dir()                          ' 次の1件。無くなると "" が返る
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    If Not wbSrc Is Nothing Then wbSrc.Close SaveChanges:=False
    Application.ScreenUpdating = True
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

Dir は、最初の呼び出しでパスを渡すと条件に合う最初のファイル名を返し、2回目からは引数なしで呼ぶと次のファイル名を返します。合うファイルが無くなると長さ0の文字列を返すので、それをループの終わりの条件にします。

23. 日時入りの名前でバックアップを保存する

Option Explicit

Sub Sample23_SaveBackupCopy()
    Dim wb As Workbook
    Dim backupPath As String

    On Error GoTo ErrHandler
    Set wb = ThisWorkbook
    backupPath = wb.Path & Application.PathSeparator & _
        "backup_" & Format(Now, "yyyymmdd_hhnnss") & ".xlsm"

    wb.SaveCopyAs Filename:=backupPath
    MsgBox "保存しました：" & backupPath, vbInformation
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

SaveCopyAs は、開いているブックはそのままに、コピーだけをファイルに保存します。Format 関数の書式では、分は nn と書きます（mm は月の意味になります）。

24. シートを PDF にする

Option Explicit

Sub Sample24_ExportPdf()
    Dim ws As Worksheet
    Dim pdfPath As String

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    pdfPath = ThisWorkbook.Path & Application.PathSeparator & "注文一覧.pdf"

    ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath, OpenAfterPublish:=False
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

ws を ThisWorkbook に変えると、ブック全体を1つの PDF にできます（Workbook.ExportAsFixedFormat も同じ引数です）。

25. 表を CSV ファイルに書き出す

Option Explicit

Sub Sample25_ExportCsv()
    Dim ws As Worksheet
    Dim data As Variant
    Dim rowCount As Long, colCount As Long, i As Long, j As Long
    Dim fields() As String
    Dim fileNo As Integer
    Dim csvPath As String
    Dim isOpen As Boolean

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    csvPath = ThisWorkbook.Path & Application.PathSeparator & "orders.csv"

    data = ws.Range("A1").CurrentRegion.Value
    rowCount = UBound(data, 1)
    colCount = UBound(data, 2)
    ReDim fields(1 To colCount)

    fileNo = FreeFile
    Open csvPath For Output As #fileNo
    isOpen = True
    For i = 1 To rowCount
        For j = 1 To colCount
            fields(j) = CStr(data(i, j))
        Next j
        Print #fileNo, Join(fields, ",")
    Next i
    Close #fileNo
    Exit Sub
ErrHandler:
    If isOpen Then Close #fileNo
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

FreeFile で空いているファイル番号をもらい、Open … For Output で書き込み用に開き、Print # で1行ずつ書いて Close で閉じます。値の中にカンマが入るデータでは、値を二重引用符で囲む処理を足してください。

26. ファイルを選ぶダイアログを出す

Option Explicit

Sub Sample26_PickFile()
    Dim picked As Variant

    On Error GoTo ErrHandler
    picked = Application.GetOpenFilename( _
        FileFilter:="Excel ファイル (*.xlsx), *.xlsx", Title:="取り込むファイルを選んでください")

    If VarType(picked) = vbBoolean Then
        MsgBox "キャンセルされました。", vbInformation
        Exit Sub
    End If

    MsgBox "選ばれたファイル：" & picked, vbInformation
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

GetOpenFilename は選ばれたファイルのパスを返すだけで、ファイルは開きません。キャンセルされると False を返すので、戻り値は Variant で受け取り、VarType で種類を確かめます。受け取ったパスをサンプル21の srcPath に渡すと、選んだファイルを取り込む流れになります。

対話と仕上げのサンプル（No.27〜30）

27. 「はい／いいえ」で確認してから処理する

Option Explicit

Sub Sample27_ConfirmBeforeRun()
    Dim ws As Worksheet
    Dim answer As Long

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("抽出")

    answer = MsgBox("「抽出」シートの内容を消去します。よろしいですか？", vbYesNo + vbQuestion, "確認")
    If answer <> vbYes Then Exit Sub

    ws.Cells.ClearContents
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

vbYesNo（値は 4）で「はい」「いいえ」のボタン、vbQuestion（値は 32）で問い合わせのアイコンを表示します。戻り値は「はい」が vbYes（6）、「いいえ」が vbNo（7）です。

28. 数値を入力してもらう

Option Explicit

Sub Sample28_AskNumber()
    Dim ws As Worksheet
    Dim answer As Variant
    Dim threshold As Double
    Dim lastRow As Long, i As Long, hit As Long

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")

    answer = Application.InputBox(Prompt:="数量がいくつ以上の行を数えますか？", Title:="条件の入力", Type:=1)
    If VarType(answer) = vbBoolean Then Exit Sub     ' キャンセル

    threshold = CDbl(answer)
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow
        If ws.Cells(i, 6).Value >= threshold Then hit = hit + 1
    Next i

    MsgBox "数量 " & threshold & " 以上は " & hit & " 件です。", vbInformation
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

Application.InputBox は、Type 引数で受け付ける値の種類を決められます。1 は数値、2 は文字列、8 はセル範囲です。キャンセルされると False を返します。

29. 画面更新と再計算を止めて処理を速くする

Option Explicit

Sub Sample29_FastTemplate()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim prevCalc As XlCalculation

    prevCalc = Application.Calculation       ' 今の計算方法を最初に覚えておく
    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    For i = 2 To lastRow
        ws.Cells(i, 8).Value = ws.Cells(i, 6).Value * ws.Cells(i, 7).Value
    Next i

CleanUp:
    Application.Calculation = prevCalc
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
    Resume CleanUp
End Sub

リファレンスにも、画面更新を止めるとマクロが速くなること、マクロの終わりで ScreenUpdating を True に戻すことが書かれています。エラーのときも設定を元に戻せるよう、Resume CleanUp で後始末の行へ進めています。今の計算方法は最初に prevCalc へ覚えておくので、どの行で止まっても元の設定に戻ります。

30. 数値でないセルを処理の前に見つける

Option Explicit

Sub Sample30_CheckNumericCells()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim v As Variant
    Dim report As String

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets("注文")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastRow
        v = ws.Cells(i, 6).Value
        If IsEmpty(v) Then
            report = report & i & "行目：数量が空です" & vbCrLf
        ElseIf Not IsNumeric(v) Then
            report = report & i & "行目：数量が数値ではありません（" & CStr(v) & "）" & vbCrLf
        End If
    Next i

    If report = "" Then
        MsgBox "数量の列はすべて数値です。", vbInformation
    Else
        MsgBox report, vbExclamation, "入力の確認"
    End If
    Exit Sub
ErrHandler:
    MsgBox "エラー " & Err.Number & "：" & Err.Description, vbExclamation
End Sub

計算の前にこのチェックを通しておくと、文字が混ざったセルで起きる実行時エラー13を前もって避けられます。

実行時エラー9・13・91・1004の原因と直し方

表の見出しは Microsoft Learn の日本語ページと英語ページの題名です。どのエラーでも、まず止まった行と、そのときの変数の中身を確かめるのが近道です。この記事のひな形のように Err.Number と Err.Description をメッセージに出しておくと、番号と説明の両方が手がかりになります。

よくある質問

Q. マクロを書いたブックを保存したら、次に開いたときマクロが消えていました。 A. 通常のブック（.xlsx）にはマクロを保存できません。ファイルの種類をマクロ有効ブック（.xlsm）にして保存してください。VBA から保存する場合は FileFormat:=xlOpenXMLWorkbookMacroEnabled（値は 52）を指定します。

Q. Option Explicit を付けたら「変数が定義されていません」と出るようになりました。 A. それが Option Explicit の役目です。宣言していない変数、または打ちまちがえた変数名を知らせてくれています。Dim 変数名 As 型 を追加するか、つづりを直してください。

Q. 最終行の取得はどれを使えばよいですか？ A. 注文IDのように必ず入力される列があるなら ws.Cells(ws.Rows.Count, 列番号).End(xlUp).Row が基本です。列によって入力がばらばらな表では Find を使う方法、すき間なく続く1つの表なら CurrentRegion が向いています。

Q. ActiveSheet と ThisWorkbook.Worksheets("名前") はどう違いますか？ A. ActiveSheet はそのとき手前に表示されているシートで、実行するたびに変わる可能性があります。ThisWorkbook.Worksheets("名前") は、マクロが書かれたブックの決まったシートを指します。対象を固定したい処理では後者が安心です。

まとめ

• マクロは開発タブ → Visual Basic → 挿入 → 標準モジュールに書き、.xlsm（マクロ有効ブック）で保存する
• すべてのコードを Option Explicit・型つきの Dim・On Error GoTo と Exit Sub の同じ形にそろえると読みやすい
• 最終行は End(xlUp) が基本。UsedRange・CurrentRegion・Find は表の形に合わせて選ぶ
• ループは回数が決まっていれば For、集まりを回すなら For Each、終わりが前もってわからなければ Do Loop
• 行の削除は下から上へ、Find の結果は Is Nothing を判定、Header は xlYes を明示
• DisplayAlerts・ScreenUpdating・Calculation を変えたら、エラーのときも元に戻す
• エラー9はシート名や配列の範囲、13は型、91は Set と Nothing、1004は Excel 側の条件を確かめる

参考・出典

• Microsoft Learn「Excel VBA reference」の各ページ：Range.End／Worksheet.UsedRange／Range.CurrentRegion／Range.Find／Range.FindNext／Range.Replace／Range.RemoveDuplicates／Range.Sort／Range.AutoFilter／Range.SpecialCells／Range.Copy／Range.PasteSpecial／Range.AutoFit／Range.Value／Range.Resize／Sheets.Add／Worksheet.Copy／Worksheet.Delete／Worksheet.AutoFilterMode／Worksheet.ExportAsFixedFormat／Workbooks.Open／Workbook.Close／Workbook.SaveAs／Workbook.SaveCopyAs／Application.GetOpenFilename／Application.InputBox／Application.DisplayAlerts／Application.ScreenUpdating／Application.CutCopyMode、および XlDirection・XlFileFormat・XlPasteType・XlSortOrder・XlYesNoGuess・XlLookAt・XlCalculation などの列挙（原稿：GitHub MicrosoftDocs/VBA-Docs、2026-10-05 閲覧）
• Microsoft Learn「Option Explicit statement」「On Error statement」「For...Next statement」「For Each...Next statement」「Do...Loop statement」「Dir function」「MsgBox function」「Format function」「Open statement」「Print # statement」「Dictionary object」「Subscript out of range (Error 9)」「Type mismatch (Error 13)」「Object variable not set (Error 91)」「Application-defined or object-defined error」「Getting started with VBA in Office」「Insert menu」（同上）
• Microsoft サポート「Run a macro in Excel」（support.microsoft.com、2026-10-05 閲覧）

株式会社RJC ― SI事業・SES事業・AI駆動開発。RJCは一緒に成長を楽しめる会社です。