KE2

以下の営業報告書には、「確認日」という項目とチェックボックスが用意されています。

このチェックボックスをチェックすることで、チェックボックスが「実行時の日付」に置き換わり、シートがロック（保護）され、そのシートの編集ができなくなります。

※こちらで作成したファイルは、記事の最後にて配布しています。

このように、書類の確認と同時にロック（保護）する仕組みの実現方法について紹介していきます。

1. 開発準備

今回は、予め用意したシート内の特定のチェックボックスをチェックすると同時に、そのシートをロック（保護）する仕組みを実現していきます。

チェックボックスは、[挿入]タブの[チェックボックス]を使用しており、チェックボックスが配置されたセルには、「FALSE」という値が入力されています。

チェックボックスをチェックすると、セルの値は「TRUE」に変わります。

このように指定したシートのセルの値が変わると同時に、シートをロック（保護）するなどと何かしらの処理を実行するには、「シートモジュール」の「イベントプロシージャ」を活用します。
シートモジュールは、対象シートのタブ上で右クリックし、[コードの表示]を選択することで表示できます。

選択すると、以下のエディタ画面（VBE）が表示されます。
また、対象シートのシートモジュールが表示された状態になります。
「Option Explicit」は、VBEの設定内容次第では表示されません。「Option Explicit」についての解説はこちらでは省略します。

次に、対象シートのセルを編集すると同時に処理が実行される特殊なプロシージャ（イベントプロシージャ）を用意する必要があります。
そのためには、シートモジュールの左上のリストから「Worksheet」を選択します。

「Worksheet」を選択すると、自動で「Worksheet_SelectionChange」というプロシージャが表示されます。
このプロシージャは、対象シートのいずれかのセルが選択されると同時に処理が実行されるイベントプロシージャになります。

ただ、今回使用するイベントプロシージャは、セルを編集すると同時に処理が実行されるものになります。
そのため、右上のリストから「Change」を選択します。

表示された「Worksheet_Change」というプロシージャを活用します。
「Worksheet_SelectionChange」というプロシージャに関しては削除して問題ないです。

2. コードの記述

以下のコードを記述します。

Private Sub Worksheet_Change(ByVal Target As Range)
    
    With Range("E5")
        If .Value = True Then
           .Value = Date
           Me.Protect
        End If
    End With
    
End Sub

では、コードについて解説していきます。

    With Range("E5")
        '省略
    End With

「With」と「End With」で囲むことで、この中では「With」に指定した「Range(“E5”)」を省略して記述することができます。
省略する際は「.」から記述します。

        If .Value = True Then
           .Value = Date
           Me.Protect
        End If

次に、「If」でセルE5（「With」で指定したセル）が「True（チェックボックスがチェックされた状態）」かどうかを確認し、「True」の場合は、そのセルの値を実行時の日付（Date）にし、シートを保護（Me.Protect）しています。

3. 完成

以上の内容で実現できます。
対象シートのセルE5に配置されたチェックボックスをチェックすると同時に、チェックボックスは実行時の日付に置き換わり、シートがロック（保護）されます。

運用時は、作成したシートをテンプレートとし、シートを複製して活用するとよいです。
シートを複製すると、複製元シートのシートモジュールの内容も、複製したシートに反映されます。

▼サンプルファイル▼

以下は、タスク管理表です。

完了したタスクを選択して、「完了」ボタンを押すだけで、そのタスクが「完了」シートに移動します。

※こちらで作成したファイルは、記事の最後にて配布しています。

このような、ボタン１つで完了タスクを別シートに移動する仕組みの実現方法について紹介します。

1. 開発準備

まずは、「未完了」シートと「完了」シートを用意し、「完了」シートには空の表を用意します。

次に、[開発]タブから[マクロ]を選択し、表示された設定画面にて、開発する機能の名前を入力して、[作成]を選択します。
こちらでは、「MoveTask」と入力しています。

次に表示される以下の画面の「Sub ○○」から「End Sub」の間にコードを記述します。
「Option Explicit」は、VBEの設定内容次第では表示されません。「Option Explicit」についての解説はこちらでは省略します。

2. コードの記述

以下のコードを記述します。

Sub MoveTask()
    
    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Set w1 = Worksheets("未完了")
    Set w2 = Worksheets("完了")
    
    Dim r1 As Long
    Dim r2 As Long
    r1 = ActiveCell.Row
    r2 = w2.Cells(w2.Rows.Count, "A").End(xlUp).Row + 1
    
    w2.Range(w2.Cells(r2, "A"), w2.Cells(r2, "C")).Value = _
        w1.Range(w1.Cells(r1, "A"), w1.Cells(r1, "C")).Value
    w1.Rows(r1).Delete
    
End Sub

では、コードについて解説していきます。

    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Set w1 = Worksheets("未完了")
    Set w2 = Worksheets("完了")

シート情報を割り当てる用の変数（w1とw2）を用意し、それぞれに「未完了」シートと
「完了」シートを割り当てています。

    Dim r1 As Long
    Dim r2 As Long
    r1 = ActiveCell.Row
    r2 = w2.Cells(w2.Rows.Count, "A").End(xlUp).Row + 1

数値を格納する用の変数（r1とr2）を用意し、「r1」にアクティブセル（現在選択している基準のセル）の行番号、「r2」に「完了」シートの表の末尾の行番号を格納しています。

「r2」について詳しく解説すると、「完了」シートのA列の末尾を選択し、Ctrlキーを押しながらカーソルキーの「↑」を押して止まった位置のセルの行番号に１を加えた数値を格納しています。

    w2.Range(w2.Cells(r2, "A"), w2.Cells(r2, "C")).Value = _
        w1.Range(w1.Cells(r1, "A"), w1.Cells(r1, "C")).Value
    w1.Rows(r1).Delete

「完了」シートの表の末尾のA列からC列に、「未完了」シートのアクティブセルの行のA列からC列の値を格納し、「未完了」シートのアクティブセルの行を削除しています。

3. ボタンの作成

コードが完成したら、実行用のボタンを用意します。

ボタンは、[開発]タブの中の[挿入]から作成することができます。
ボタンには開発した機能「MoveTask」を割り当てます。

4. 完成

以上の手順で完成です。
完了したタスク（同じ行のいずれかのセル）を選択し、「完了」ボタンを押すことで、その行のタスクが「完了」シートに移動します。

注意点として、今回のコードには、移動対象のタスクの行の範囲を指定していません。
そのため、１行目を選択して「完了」ボタンを押してしまうと、見出しが移動してしまいます。

そのため、必要に応じて、コード内で「行番号が２以上のとき」などといった条件分岐を行うとよいです。

▼サンプルファイル▼

以下のような「円グラフを活用したルーレット」を作成する方法について紹介していきます。

※こちらで開発したファイルは、記事の最後にて配布しています。

1. 準備

以下の円グラフは、上の表（「はずれ」と「あたり」の割合）をもとに作成しています。
また、「▼」は別で作成した図形を重ねています。

上の表の「あたり」の割合は、以下のような数式で求めています。

=1-C3
// 1と「はずれ」の割合の差

そのため、「はずれ」の割合を変更するだけで、「あたり」の割合が自動で設定されます。

2. 実現方法

今回は、円グラフの「グラフの基線位置」を活用して、ルーレットを実現していきます。

円グラフは、「データ系列の書式設定」にある「グラフの基線位置」を変更することで回転させることができます。

こちらの値を、マクロで操作することで実現していきます。

3. コードの記述

以下のコードを記述します。

Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Sub Roulette()
    
    Dim ch As Chart
    Set ch = Worksheets("ルーレット").ChartObjects("グラフ 1").Chart
    
    Dim startN As Long, lastN As Long
    startN = ch.ChartGroups(1).FirstSliceAngle
    lastN = Int((360 + 1) * Rnd) + 360 * 6
    
    Dim n As Long
    n = startN
    Do While n < lastN
        DoEvents
        ch.ChartGroups(1).FirstSliceAngle = n Mod 360
        Sleep 5
        If lastN - n > 360 * 3 Then
            n = n + 10
        Else
            n = n + 10 - Int((n - 360 * 3) / (lastN - 360 * 3) * 10)
        End If
    Loop
    
End Sub

では、コードについて解説していきます。
※複雑なコードのため簡単に解説します。

Option Explicit

変数宣言を強制する際に記述するものです。
変数宣言を省略したい場合は、記述する必要はありません。

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Windows APIにある「Sleep」というプロシージャを使えるようにするための宣言です。

    Dim ch As Chart
    Set ch = Worksheets("ルーレット").ChartObjects("グラフ 1").Chart
    
    Dim startN As Long, lastN As Long
    startN = ch.ChartGroups(1).FirstSliceAngle
    lastN = Int((360 + 1) * Rnd) + 360 * 6

対象のグラフを変数「ch」に割り当てて、そのグラフの基線位置を変数「startN」に格納しています。
変数「lastN」には、６周分の角度に、ランダムな角度を加えた角度を格納しています。
変数「lastN」が、回転を止める位置になります。

    Dim n As Long
    n = startN
    Do While n < lastN
        '省略
    Loop

変数「n」に変数「startN」の値を格納し、その変数「n」の値が変数「lastN」の値より小さい間、「Do」から「Loop」の中を繰り返し実行します。

        DoEvents
        ch.ChartGroups(1).FirstSliceAngle = n Mod 360
        Sleep 5
        If lastN - n > 360 * 3 Then
            n = n + 10
        Else
            n = n + 10 - Int((n - 360 * 3) / (lastN - 360 * 3) * 10)
        End If

繰り返しの中では、変数「n」の値を徐々に増やしています。
処理の流れは、以下になります。

１．変数「n」の値（角度）をグラフの基線位置に反映（０～３５９の間になるように３６０で割った余りを活用） ２．５ミリ秒（０．００５秒）停止

この次が少しだけややこしくなります。
ルーレットでは、回転が徐々に減速する演出にするために、以下のような処理にしています。

残りの回転角度が３周より多い場合は、変数「n」に１０を加算 そうでない場合は、徐々に加算する数を減らす

4. ボタンの作成

記述したプロシージャ（Roulette）を割り当てたボタンを作成します。
こちらでは、立体的な見た目の図形（四角形：角度付き）を挿入して、その図形に割り当てています。

5. 完成

以上の手順で完成です。
作成したボタンをクリックすることで、円グラフが回転します。

▼サンプルファイル▼

以下のように、「表示切替」ボタンを押すことで、複数あるシートから今月のシートのみを表示することができ、再度ボタンを押すことで、すべてのシートを表示することができる仕組みの実現方法について紹介します。

※こちらで開発したファイルは、記事の最後にて配布しています。

1. 開発準備

今回は、以下のように「1月」から「12月」という名前のシートが含まれるブックに対して実現していきます。

また、「設定」シートの「表示切替」ボタンを配置する予定のセルに、「TRUE」もしくは「FALSE」と入力します。

この値は、現在のシートの状態を表しています。
「TRUE」ならば、すべてのシートが表示されている状態、「FALSE」ならば、一部のシートが非表示の状態になります。
※仕組みを実装する前は、シートの状態に関係なく「TRUE」もしくは「FALSE」の値を入力しておきます。

次に、[開発]タブを選択し、[マクロ]を選択します。

以下の画面にて、開発する機能の名前を入力し、[作成]を選択します。
こちらでは、「ToggleSheetView」と入力しています。

次に表示される以下の画面の「Sub ○○」から「End Sub」の間にコードを記述します。
「Option Explicit」は、VBEの設定内容次第では表示されません。「Option Explicit」についての解説はこちらでは省略します。

2. コードの記述

以下のコードを記述します。

Sub ToggleSheetView()
    
    Dim ws As Worksheet
    Set ws = Worksheets("設定")
    
    Dim m As Long
    m = Month(Date)
    
    Dim ckRng As Range
    Set ckRng = ws.Range("B3")
    ckRng.Value = Not ckRng.Value
    
    Dim i As Long
    For i = 1 To 12
        On Error Resume Next
        With Worksheets(i & "月")
            If i = m Or ckRng.Value Then
                .Visible = xlSheetVisible
            Else
                .Visible = xlSheetHidden
            End If
        End With
        On Error GoTo 0
    Next i
    
    ws.Activate
    
End Sub

では、コードについて解説していきます。

    Dim ws As Worksheet
    Set ws = Worksheets("設定")
    
    Dim m As Long
    m = Month(Date)

シート情報を割り当てる用の変数（ws）を用意し、ボタンを配置する予定の「設定」シートを割り当てています。
次に、現在の月を格納する用の変数（m）を用意し、現在の月を格納しています。

    Dim ckRng As Range
    Set ckRng = ws.Range("B3")
    ckRng.Value = Not ckRng.Value

シートの表示非表示の状態を表す値が入力されたセルの情報を割り当てる用の変数（ckRng）を用意し、対象のセル（「設定」シート（ws）のセルB3）を割り当てています。
そして、その対象のセルの現在の値を、「TRUEならばFALSE」、「FALSEならばTRUE」と反転させています。

    Dim i As Long
    For i = 1 To 12
        On Error Resume Next
        With Worksheets(i & "月")
            '省略
        End With
        On Error GoTo 0
    Next i

繰り返し処理で使う用の変数（i）を用意し、Forで「1」から「12」まで１つずつ繰り返しています。
「For～Next」の中では、「1月」から「12月」のシートを１つずつ繰り返しています。

「Worksheets(i & “月”)」と直接シート名で指定しているため、対象のシート名のシートが存在しないときにエラーになってしまいます。
その対策として、「On Error Resume Next」と「On Error GoTo 0」を記述しています。
「On Error Resume Next」で、それ以降でエラーになった際に、エラーを飛ばして処理を実行することができます。
「On Error GoTo 0」で、「On Error Resume Next」の設定を解除しています。

            If i = m Or ckRng.Value Then
                .Visible = xlSheetVisible
            Else
                .Visible = xlSheetHidden
            End If

Withの中で、「繰り返された対象の月と実行したときの月が同じ場合」、もしくは、「シートの表示非表示の状態を表すセルの値がTRUEの場合」は、繰り返された対象の月のシートを表示しています。
それ以外の場合は、繰り返された対象の月のシートを非表示にしています。

※「With」から「End With」で囲まれている範囲内は、「With」で指定した情報を省略して「.」から記述することができます。

    ws.Activate

シートの表示非表示を切り替える処理で、選択されているシートが変わってしまうことがあるため、最後に「設定」シートを選択しています。

3. ボタンの作成

コードが完成したら、実行用のボタンを用意します。
ボタンは、[開発]タブの中の[挿入]から作成することができます。

4. 完成

以上の手順で完成です。
「設定」シートに配置した「表示切替」ボタンを押すことで、シートの表示非表示を切り替えることができます。

▼サンプルファイル▼

以下の左側のシートに用意された表の値を変更すると、「変更履歴」シートの変更履歴表に変更内容が自動で記録されます。

※こちらで開発したファイルは、記事の最後にて配布しています。

このような、予め指定した範囲内のセルの値を変更した際に、変更履歴表に自動で記録する仕組みの実現方法について解説していきます。

1. 開発準備

今回は、予め指定した範囲内のセルの値を変更すると同時に、変更履歴表に自動で記録する仕組みを作っていきます。

そのように、該当するシートの特定のセルを編集すると同時に何かしらの処理を実行するには、「シートモジュール」の「イベントプロシージャ」を活用します。
シートモジュールは、該当するシートのタブ上で右クリックし、[コードの表示]を選択することで表示できます。

選択すると、以下のエディタ画面（VBE）が表示されます。
また、該当するシートのシートモジュールが表示された状態になります。
「Option Explicit」は、VBEの設定内容次第では表示されません。「Option Explicit」についての解説はこちらでは省略します。

次に、該当するシートのセルを編集すると同時に処理が実行される特殊なプロシージャ（イベントプロシージャ）を用意する必要があります。
そのためには、シートモジュールの左上のリストから「Worksheet」を選択します。

「Worksheet」を選択すると、自動で「Worksheet_SelectionChange」というプロシージャが表示されます。
このプロシージャは、該当するシート上のいずれかのセルが選択されると同時に処理が実行されるイベントプロシージャになります。

ただ、今回使用するイベントプロシージャは、セルを編集すると同時に処理が実行されるものになります。
そのため、右上のリストから「Change」を選択します。

表示された「Worksheet_Change」というプロシージャを活用します。
「Worksheet_SelectionChange」というプロシージャに関しても、今回は使用するため残しておきます。

2. コードの記述

以下のコードを記述します。

Dim oldValue As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.CountLarge = 1 And _
        Target.Row >= 2 And _
        Target.Column <= 3 Then
        
        With Worksheets("変更履歴")
            .Rows(2).Insert CopyOrigin:=xlFormatFromRightOrBelow
            .Range("A2").Value = Now
            .Range("B2").Value = Target.Address(False, False)
            .Range("C2").Value = oldValue
            .Range("D2").Value = Target.Value
        End With
        
    End If
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Target.CountLarge = 1 Then
        oldValue = Target.Value
    End If
    
End Sub

では、コードについて解説していきます。

Private Sub Worksheet_Change(ByVal Target As Range)
    
    '省略
    
End Sub

「Worksheet_Change」というプロシージャの引数の「Target」に、編集されたセルの情報が渡されます。
そのセルの情報を用いて、「変更履歴」シートに記録していくのですが、引数の「Target」から取得できる情報は、編集されたセルの情報のみのため、変更前のセルの値を取得することができません。
そのため、変更前のセルの情報を次の処理で、予め取得して保持しておく必要があります。

Dim oldValue As Variant

'省略

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Target.CountLarge = 1 Then
        oldValue = Target.Value
    End If
    
End Sub

「Worksheet_SelectionChange」というプロシージャの引数の「Target」に、選択されたセルの情報が渡されます。
セルの値を変更する前にセルを選択するという動作があります。
そのため、「Worksheet_SelectionChange」のプロシージャが実行された時点では、変更前のセルの情報（Target）を取得することができます。
そのセルの情報（Target）から、変数「oldValue」に変更前のセルの値を格納しています。

変数「oldValue」は、「Worksheet_SelectionChange」のプロシージャだけでなく、「Worksheet_Change」のプロシージャからでも参照できるようにする必要があります。
そのため、プロシージャの外に変数を宣言しています。
セルの値を格納する用の変数のため、数値や日付など色んな型を格納できるようにVariant型で宣言しています。

プロシージャの外に宣言した変数（モジュールレベルの変数）に格納した値は、プロシージャの処理が終了した後でも保持されます。
そのため、常に変更前のセルの値を保持することができます。

今回の場合は、単体のセルが変更されたときのみに変更履歴を記録するようにしているため、選択されているセルが１つであることを「If Target.CountLarge = 1 Then」で確認しています。

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.CountLarge = 1 And _
        Target.Row >= 2 And _
        Target.Column <= 3 Then
        
        '省略
        
    End If
    
End Sub

「Worksheet_Change」のプロシージャでは、変更履歴を記録する処理を行います。
そのため、変更履歴を記録する対象の範囲内が変更されたかどうかを確認しています。

今回の場合は、変更されたセルが１つであり、行番号が２以上、列番号が３以下であることを前提としています。
これは、「商品管理」シートに用意された表のデータの範囲になります。

この条件を満たしたときに、Ifの中の処理を実行します。

        With Worksheets("変更履歴")
            .Rows(2).Insert CopyOrigin:=xlFormatFromRightOrBelow
            .Range("A2").Value = Now
            .Range("B2").Value = Target.Address(False, False)
            .Range("C2").Value = oldValue
            .Range("D2").Value = Target.Value
        End With

先ほどのIfの中の処理です。
こちらは、「変更履歴」シートの変更履歴表の先頭行に、変更履歴を記録する内容になっています。
そのため、「With」で「変更履歴」シートを指定して囲み、「With」から「End With」までの範囲内では、「変更履歴」シートの情報を省略して記述できるようにしています。

「.Rows(2).Insert CopyOrigin:=xlFormatFromRightOrBelow」で、「変更履歴」シートの２行目に行を挿入し、下の行（３行目）の書式を引き継いでいます。
そして、挿入した２行目の個々のセルに、以下の値を入力しています。

・セルA2：Now // 現在日時
・セルB2：Target.Address(False, False) // 更新されたセルの相対参照のアドレス
・セルC2：oldValue // 変更前のセルの値
・セルD2：Target.Value // 変更後のセルの値

3. 完成

以上の内容で実現できます。
予め指定した範囲内のセルの値を変更すると、「変更履歴」シートの変更履歴表に変更内容が自動で記録されます。
また、最後に変更した内容が、変更履歴表の先頭に記録されるようになっています。

▼サンプルファイル▼

以下の予定表は、セルC2に配置されたスピンボタンを押すことで、１週間単位で表示する日付を切り替えることができます。

※こちらで実現したファイルは、記事の最後にて配布しています。

こちらは、実際の値が置き換わっている訳ではなく、対象の週以外の列が非表示になっています。

そのため、表示されているセルに直接値を入力しても問題ございません。

今回は、上記のように、スピンボタンで表示する列を一定間隔で切り替える仕組みを実現していきます。

1. スピンボタンの用意

今回は、以下のすべての列が表示されている予定表から作成していきます。

まずは、スピンボタンを用意します。
スピンボタンは、[開発]タブの中の[挿入]から[スピンボタン]を選択することで、好みの位置に配置することができます。

スピンボタンの用意ができたら、スピンボタンの上で右クリックし、[コントロールの書式設定]を選択します。

[コントロールの書式設定]にて、以下のように設定します。

スピンボタンで指定した数値が、予定表の表示する週になります。
[最大値]を５０にすると、最大５０週目までしか表示できなくなります。
そのため、必要に応じて[最大値]は修正してください。

[リンクするセル]は、スピンボタンの現在値を表示させるセルになります。
こちらでは、スピンボタンの隣のセルB2を指定しています。

2. 開発準備

次は、スピンボタンをクリックすると同時に、予定表の週の表示を切り替える仕組みを実現します。
そのためには、VBAを活用します。

スピンボタンに連動する機能を開発する必要があるため、スピンボタンの上で右クリックし、[マクロの登録]を選択します。

[マクロの登録]の画面にて、開発する機能の名前を入力し、[新規作成]を選択します。
こちらでは、「表示切替」と入力しています。

次に表示される以下の画面の「Sub ○○」から「End Sub」の間にコードを記述します。

3. コードの記述（列の表示切り替え）

以下のコードを記述します。

Sub 表示切替()

    Dim no As Long
    no = Range("B2").Value
    
    Columns("D:MY").Hidden = True
    Range( _
        Columns(no * 7 - 3), _
        Columns(no * 7 + 3)).Hidden = False
        
End Sub

では、コードについて解説していきます。

    Dim no As Long
    no = Range("B2").Value

「no」という整数（Long）専用の変数（入れ物）を用意し、その「no」にセルB2の値（表示する週を表す数値）を格納しています。

    Columns("D:MY").Hidden = True

予定表の日付の列全体を非表示にしています。

    Range( _
        Columns(no * 7 - 3), _
        Columns(no * 7 + 3)).Hidden = False

「no」の値から対象の週を指定し、対象の週の列を表示しています。

「no」が１のときは、１週目である４列目から１０列目を表示し、
「no」が２のときは、２週目である１１列目から１７列目を表示します。
この関係性を「no」を用いた数式で表すと、「no * 7 – 3」列目から「no * 7 + 3」列目になります。

そのため、「Range」で「Columns(no * 7 – 3)」から「Columns(no * 7 + 3)」と対象の列の範囲を指定しています。

4. 完成

以上の手順で完成です。
スピンボタンを押すことで、対象の週のみが表示されるようになります。

▼サンプルファイル▼

シート上の表の内容をもとに、データ数分のフォルダを一括で作成する仕組みを実現していきます。

こちらでは、以下のように、生徒一覧表の内容をもとに「No_氏名」という名前のフォルダを一括で作成する仕組みを実現していきます。

※こちらで実現したファイルは、記事の最後にて配布しています。

1. 開発準備

まず初めに、[開発]タブを選択し、[マクロ]を選択します。

表示された以下の画面にて、開発する機能の名前を入力し、[作成]を選択します。
こちらでは、「GenerateFolders」と入力しています。

次に表示される以下の画面の「Sub ○○」から「End Sub」の間にコードを記述します。

2. コードの記述（フォルダ一括作成）

以下のコードを記述します。

Sub GenerateFolders()
    
    Dim i As Long
    For i = 3 To 32
        '保存先のフォルダのパスを貼り付けて「\」を追加
        MkDir "A:\出力\" & _
            Cells(i, "B").Value & "_" & _
            Cells(i, "C").Value
    Next i
    
End Sub

では、コードについて解説していきます。

    Dim i As Long
    For i = 3 To 32
        '省略
    Next i

表の１行１行を繰り返す際に使用する変数（i）を用意し、「For」で変数（i）を３～３２までを繰り返して実行します。

３～３２という数値は、フォルダを作成する対象のデータが入力されている行の範囲になります。

        '保存先のフォルダのパスを貼り付けて「\」を追加
        MkDir "A:\出力\" & _
            Cells(i, "B").Value & "_" & _
            Cells(i, "C").Value

「MkDir」の後に作成したいフォルダのパスを指定することで、フォルダを作成できます。

今回作成するフォルダの位置は、「Aドライブの中の出力フォルダの中」になるので、先頭に「”A:\出力\”」とパスを指定しています。

その後には、作成するフォルダの名前をセルの値を用いて指定しています。
「Cells(i, “B”).Value」で繰り返し処理で使用している変数（i）の値の行にあるB列の値（No）を取得し、「& “_”」で「_」を加え、「& Cells(i, “C”).Value」で変数（i）の値の行にあるC列の値（氏名）を加えています。
※「 _」は１つのコードを改行するときに指定します。

3. 完成

以上の手順で完成です。
作成したコードを指定して実行することで、瞬時にフォルダが作成されます。

4. 補足（Noを「０埋め２桁表記」にする）

作成するフォルダ名の先頭のNoを「０埋めの２桁表記」にしたい場合は、以下のように、「Format」を活用することで実現できます。

        MkDir "A:\出力\" & _
            Format(Cells(i, "B").Value, "00") & "_" & _
            Cells(i, "C").Value

「Format」についての詳しい解説は省略しますが、ワークシート上の「TEXT関数」とほぼ同じようなものです。

上記の内容に書き換えて実行すると、以下のように、Noを「０埋め２桁表記」で作成できます。

▼サンプルファイル▼

以下の書類フォーマットは、書類の中に直接入力することも、書類の下の表に入力して書類の中に反映させることもできます。

※こちらで開発したファイルは、記事の最後にて配布しています。

このような、双方向からの入力を実現する方法について解説していきます。

1. 開発準備

今回は、予め指定したセルに値を入力すると同時に、そのセルに紐づいた別のセルにも同じ値を入力する仕組みを作っていきます。

そのように、該当するシートの特定のセルを編集すると同時に何かしらの処理を実行するには、「シートモジュール」の「イベントプロシージャ」を活用します。
シートモジュールは、該当するシートのタブ上で右クリックし、[コードの表示]を選択することで表示することができます。

選択すると、以下のエディタ画面（VBE）が表示されます。
また、該当するシートのシートモジュールが表示された状態になります。
「Option Explicit」は、VBEの設定内容次第では表示されません。「Option Explicit」についての解説はこちらでは省略します。

次に、該当するシートのセルを編集すると同時に処理が実行される特殊なプロシージャ（イベントプロシージャ）を用意する必要があります。
そのためには、シートモジュールの左上のリストから「Worksheet」を選択します。

「Worksheet」を選択すると、自動で「Worksheet_SelectionChange」というプロシージャが表示されます。
このプロシージャは、該当するシート上のいずれかのセルが選択されると同時に処理が実行されるイベントプロシージャになります。

ただ、今回使用するイベントプロシージャは、セルを編集すると同時に処理が実行されるものになります。
そのため、右上のリストから「Change」を選択します。

表示された「Worksheet_Change」というプロシージャを活用します。
「Worksheet_SelectionChange」というプロシージャに関しては削除して問題ないです。

2. コードの記述

以下のコードを記述します。

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Application.EnableEvents = False
    
    Select Case Target.Address(False, False)
        Case "F3"
            Range("D14").Value = Target.Value
        Case "F4"
            Range("D15").Value = Target.Value
        Case "B4"
            Range("D16").Value = Target.Value
        Case "D6"
            Range("D17").Value = Target.Value
        Case "C7"
            Range("D18").Value = Target.Value
        Case "D14"
            Range("F3").Value = Target.Value
        Case  "D15"
            Range("F4").Value = Target.Value
        Case "D16"
            Range("B4").Value = Target.Value
        Case "D17"
            Range("D6").Value = Target.Value
        Case "D18"
            Range("C7").Value = Target.Value
    End Select
    
    Application.EnableEvents = True
    
End Sub

では、コードについて解説していきます。

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Application.EnableEvents = False
    
    '省略
    
    Application.EnableEvents = True
    
End Sub

「Worksheet_Change」というプロシージャの引数の「Target」に、編集されたセルの情報が渡されます。
そのセルの情報を用いて、双方向での入力を実現するのですが、処理の中で別のセルの値を編集してしまうと、再度「Worksheet_Change」が実行されてしまい無限ループになってしまいます。
そのため、処理の前後に、イベントを無効化する処理（Application.EnableEvents = False ～ Application.EnableEvents = True）を記述しています。

    Select Case Target.Address(False, False)
        Case "F3"
            Range("D14").Value = Target.Value
        Case "F4"
            Range("D15").Value = Target.Value
        Case "B4"
            Range("D16").Value = Target.Value
        Case "D6"
            Range("D17").Value = Target.Value
        Case "C7"
            Range("D18").Value = Target.Value
        Case "D14"
            Range("F3").Value = Target.Value
        Case  "D15"
            Range("F4").Value = Target.Value
        Case "D16"
            Range("B4").Value = Target.Value
        Case "D17"
            Range("D6").Value = Target.Value
        Case "D18"
            Range("C7").Value = Target.Value
    End Select

編集されたセルのアドレスから、双方向の入力をする対象のセルかどうかを判断し、対象のセルの場合は、紐づいているセルにも同じ値を入力しています。

「Target.Address(False, False)」で編集されたセルのアドレスを相対参照の形式で取得し、そのアドレスが「F3」の場合は、セルD14にも同じ値を入力、「F4」の場合は、セルD15にも同じ値を入力と、必要な組み合わせ分記述しています。

3. 完成

以上の内容で実現できます。
予め指定したセルに関しては、値を入力すると同時に、紐づいたセルにも同じ値が入力されます。

▼サンプルファイル▼

今回は、１つ１つのセルごとに割り当てましたが、表などで双方向の入力を実現する場合は、以下のように記述した方がよいです。

（例）以下の表①に入力したら表②にも反映、表②に入力したら表①にも反映させる

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Application.EnableEvents = False
    
    If Target.Row >= 3 And Target.Row <= 10 Then
        
        If Target.Column >= 2 And Target.Column <= 3 Then
            Cells(Target.Row, Target.Column + 3).Value = Target.Value
        End If
        
        If Target.Column >= 5 And Target.Column <= 6 Then
            Cells(Target.Row, Target.Column - 3).Value = Target.Value
        End If
        
    End If

    Application.EnableEvents = True
    
End Sub

こちらのコードについての詳しい解説は省略します。

以下の表は、各作業に対して「A～C」のクラスを割り当てる表です。
「A～C」にはチェックボックスが用意されており、それとは別に、「A～C」を一括でチェックする用のチェックボックス「全」も用意されています。

チェックボックスの作成方法は、以下の記事を参考にしてください。
＞チェックボックスの作成方法

この「全」と「A～C」のチェックボックスは連動しており、以下のように動作します。

---

・「全」をチェック

・A~Cをすべてチェック

・「全」を外す

---

このような、動的なチェックボックスの作成方法について解説していきます。

※こちらで開発したファイルは記事の最後にて配布しています。

1. 開発準備

今回は、特定のチェックボックスを操作すると同時に、他のチェックボックスも操作するという仕組みを作っていきます。

チェックボックスが配置されたセルには、TRUEもしくはFALSEという値が入力されています。

つまり、チェックボックスが配置されたセルの値が操作されると同時に、必要に応じて、他のチェックボックスを操作する必要があります。

そのように、該当するシートのセルを編集すると同時に処理を自動で実行するには、「シートモジュール」の「イベントプロシージャ」を活用します。
シートモジュールは、該当するシートのタブ上で右クリックし、[コードの表示]を選択することで表示することができます。

選択すると、以下のエディタ画面（VBE）が表示されます。
また、該当するシートのシートモジュールが表示された状態になります。
「Option Explicit」は、VBEの設定内容次第では表示されません。「Option Explicit」についての解説はこちらでは省略します。

次に、該当するシートのセルを編集すると同時に処理が実行される特殊なプロシージャ（イベントプロシージャ）を用意する必要があります。
そのためには、シートモジュールの左上のリストから「Worksheet」を選択します。

「Worksheet」を選択すると、自動で「Worksheet_SelectionChange」というプロシージャが表示されます。
このプロシージャは、該当するシート上のいずれかのセルが選択されると同時に処理が実行されるイベントプロシージャになります。

ただ、今回使用するイベントプロシージャは、セルを編集すると同時に処理が実行されるものになります。
そのため、右上のリストから「Change」を選択します。

表示された「Worksheet_Change」というプロシージャを活用します。
「Worksheet_SelectionChange」というプロシージャに関しては削除して問題ないです。

2. コードの記述

以下のコードを記述します。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim r As Range: Set r = Target

    If r.CountLarge = 1 And _
        r.Row >= 4 And r.Row <= 23 And _
        r.Column >= 3 And r.Column <= 6 Then
        
        Application.EnableEvents = False
        
        Dim r1 As Range: Set r1 = Cells(r.Row, "C")
        Dim r2 As Range: Set r2 = Cells(r.Row, "D")
        Dim r3 As Range: Set r3 = Cells(r.Row, "E")
        Dim r4 As Range: Set r4 = Cells(r.Row, "F")
        
        If r.Column = 3 Then
            If r.Value Then
                Range(r2, r4).Value = True
            Else
                Range(r2, r4).Value = False
            End If
        Else
            If r2 And r3 And r4 Then
                r1.Value = True
            Else
                r1.Value = False
            End If
        End If
        
        Application.EnableEvents = True
        
    End If

End Sub

では、コードについて解説していきます。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim r As Range: Set r = Target

    If r.CountLarge = 1 And _
        r.Row >= 4 And r.Row <= 23 And _
        r.Column >= 3 And r.Column <= 6 Then
        
        Application.EnableEvents = False
        
        '省略
        
        Application.EnableEvents = True
        
    End If

End Sub

「Worksheet_Change」というプロシージャの引数の「Target」に、編集されたセルの情報が渡されるため、そのセルの情報から、表の対象のセルが編集されたかどうかを確認しています。

まずは、入れ物（変数）「r」を用意し、そこにTargetの情報を割り当てています。

次に、編集されたセルが１つ（r.CountLarge = 1）で、行番号が４以上２３以下（r.Row >= 4 And r.Row <= 23）、尚且つ、列番号が３以上６以下（r.Column >= 3 And r.Column <= 6）であることを確認しています。
こちらは、「チェックボックスが配置されている範囲内のセルが、単体で編集された場合」という条件になります。

この条件を満たした場合に、Ifの中の処理を実行します。
Ifの中では、他のチェックボックスを操作する可能性があります。
チェックボックスが操作されると、「Worksheet_Change」の処理が再度実行されてしまい無限ループになってしまう恐れがあります。
そのため、Ifの処理の中では、イベントを無効化する処理（Application.EnableEvents = False ～ Application.EnableEvents = True）を記述しています。

        Dim r1 As Range: Set r1 = Cells(r.Row, "C")
        Dim r2 As Range: Set r2 = Cells(r.Row, "D")
        Dim r3 As Range: Set r3 = Cells(r.Row, "E")
        Dim r4 As Range: Set r4 = Cells(r.Row, "F")
        
        If r.Column = 3 Then
            If r.Value Then
                Range(r2, r4).Value = True
            Else
                Range(r2, r4).Value = False
            End If
        Else
            If r2 And r3 And r4 Then
                r1.Value = True
            Else
                r1.Value = False
            End If
        End If

次に、操作されたセルと同じ行にあるチェックボックスのセルの情報を入れ物（変数）「r1～r4」に割り当てています。
そして、操作されたセルの列番号が３の場合とそれ以外の場合で、処理を分岐しています。

操作されたセルの列番号が３の場合は、「全」のチェックボックスが操作されたときになります。
そのため、「全」がチェックされている場合は、「A～C」のチェックボックスすべてをチェックし、「全」がチェックされていない場合は、「A～C」のチェックボックスすべてのチェックを外しています。
「A～C」のチェックボックスが配置されたセルは、連続したセルになっています。
そのため、「A」のチェックボックスのセルから「C」のチェックボックスのセルまでということで、「Range(r2, r4)」と範囲指定することができます。

ちなみに、以下の該当する処理に関しては、１行で表現することもできます。

            If r.Value Then
                Range(r2, r4).Value = True
            Else
                Range(r2, r4).Value = False
            End If

↓

            Range(r2, r4).Value = r.Value

操作されたセルの列番号が３でない場合は、「A～C」のチェックボックスのいずれかが操作されたときになります。
そのため、「A～C」のチェックの有無を確認し、すべてがチェックされているときのみ、「全」をチェックし、それ以外は、「全」のチェックを外しています。

ちなみに、以下の該当する処理に関しても、１行で表現することができます。

            If r2 And r3 And r4 Then
                r1.Value = True
            Else
                r1.Value = False
            End If

↓

            r1.Value = r2 And r3 And r4

3. 完成

以上の内容で実現できます。
「全」と「A～C」のチェックボックスが連動するようになります。

---

・「全」をチェック

・A~Cをすべてチェック

・「全」を外す

---

▼サンプルファイル▼

数量を管理している表で、よく数量に１を加えたり、１を減らしたりと作業をしている場合、数量のセルに数値を毎回、直接入力するのは大変です。
数量の項目が少ない場合は、スピンボタンなどを活用するのも１つの手ですが、項目数が多い場合は、スピンボタン１つ１つにセルを割り当てるのは大変になります。

ということで、今回は、数量の隣のセルを直接クリックするだけで、数量に１を加えたり、１を減らしたりすることができる仕組みの作り方について解説していきます。

※こちらで開発したファイルは、記事の最後にて配布しています。

1. 開発準備

今回は、数量の隣のセルを右クリックすることで、該当行の数量のセルの値を更新するという仕組みを実装していきます。

まずは、以下の左側の表の、数量の隣のセルにボタンのようなデザインのセルを用意します。

上記では、「セルの書式設定」より罫線と背景色などを設定しています。
また、E列には「＜」、F列には「＞」という文字を直接入力しています。

ボタンのデザインの用意ができましたら、右クリックすると同時に数量を更新する仕組みを実装していきます。
特定のシートの特定のセルを右クリックすることで何かしら処理を実行するには、該当するシートのシートモジュールを活用します。

シートモジュールは、該当するシートのタブ上で右クリックし、[コードの表示]を選択することで表示することができます。

選択すると、以下のエディタ画面（VBE）が表示されます。
また、該当するシートのシートモジュールが表示された状態になります。
「Option Explicit」は、VBEの設定内容次第では表示されません。「Option Explicit」についての解説はこちらでは省略します。

次に、該当するシートのセル上で右クリックすると同時に処理が実行される特殊なプロシージャ（イベントプロシージャ）を用意する必要があります。
そのためには、シートモジュールの左上のリストから「Worksheet」を選択します。

「Worksheet」を選択すると、自動で「Worksheet_SelectionChange」というプロシージャが表示されます。
このプロシージャは、該当するシート上のいずれかのセルが選択されると同時に処理が実行されるイベントプロシージャになります。

ただ、今回使用するイベントプロシージャは、セル上で右クリックされると同時に処理が実行されるものになります。
そのため、右上のリストから「BeforeRightClick」を選択します。

表示された「Worksheet_BeforeRightClick」というプロシージャを活用します。
「Worksheet_SelectionChange」というプロシージャに関しては削除して問題ないです。

2. コードの記述

以下のコードを記述します。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    
    If Target.CountLarge = 1 And _
        Target.Row >= 3 And _
        Target.Row <= 21 And _
        Target.Column >= 5 And _
        Target.Column <= 6 Then
        
        Cancel = True
        Select Case Target.Column
            Case 5:
                Cells(Target.Row, "D").Value = _
                    Cells(Target.Row, "D").Value - 1
            Case 6:
                Cells(Target.Row, "D").Value = _
                    Cells(Target.Row, "D").Value + 1
        End Select
        
    End If
    
End Sub

では、コードについて解説していきます。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    
    If Target.CountLarge = 1 And _
        Target.Row >= 3 And _
        Target.Row <= 21 And _
        Target.Column >= 5 And _
        Target.Column <= 6 Then
        
        '省略
        
    End If
    
End Sub

「Worksheet_BeforeRightClick」というプロシージャの引数の「Target」に、右クリックされたセルの情報が渡されるため、そのセルの情報から、対象の範囲内が右クリックされたかどうかを確認しています。
こちらでは、「右クリックされたセルが単体で、３行目以上２１行目以下、５列目以上６列目以下のセル」と、対象の範囲内の単体のセルが右クリックされたかどうかを確認しています。

この条件を満たした場合に関してのみ、Ifの中の処理を実行します。

        Cancel = True
        Select Case Target.Column
            Case 5:
                Cells(Target.Row, "D").Value = _
                    Cells(Target.Row, "D").Value - 1
            Case 6:
                Cells(Target.Row, "D").Value = _
                    Cells(Target.Row, "D").Value + 1
        End Select

先ほどの条件を満たした場合は、「Cancel = True」で右クリック時のメニューが表示されないようしています。

その次に、右クリックされたセルが５列目（E列）なのか、６列目（F列）なのかによって、処理を分岐しています。
５列目（E列）の場合は、その右クリックされたセルと同じ行のD列の値（数量）に対し１を引き、６列目（F列）の場合は、その右クリックされたセルと同じ行のD列の値（数量）に対し１を足しています。

3. 完成

先ほどのコードを記述したら完成です。
「＜」もしくは「＞」が入力された以下の赤枠内のセル上で右クリックすることで、対象行の数量に対し、１を加えたり、１を減らしたりすることができます。

▼サンプルファイル▼

以下の表は、セルC2に入力した値に応じてデータが抽出されるように作られています。

今回は、このセルC2の値を「A→B→C」のように好みの値に切り替えながら、このシートの印刷範囲の内容をPDFファイルにして自動で保存する仕組みを実現していきます。

※こちらで実現したファイルは記事の最後にて配布しています。

1. 開発手順

まず初めに、[開発]タブを選択し、[マクロ]を選択します。

表示された以下の画面にて、開発する機能の名前を入力し、[作成]を選択します。
こちらでは、「ExportToPDF」と入力しています。

次に表示される以下の画面の「Sub ○○」から「End Sub」の間にコードを記述します。

2. コードの記述（PDFファイル出力）

以下のコードを記述します。

Sub ExportToPDF()
    
    Dim fPath As String
    fPath = ThisWorkbook.Path
    
    Worksheets("PDF出力").ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=fPath & "\Sample.pdf"
    
End Sub

では、コードについて解説していきます。

    Dim fPath As String
    fPath = ThisWorkbook.Path

「fPath」という変数（入れ物）を用意し、現在開いているExcelファイルの保存先のフォルダのパスを「fPath」に格納しています。
そのため、取得されるパスは環境により異なります。

こちらの環境の場合は、以下のパスが取得されます。

A:\PDF出力

    Worksheets("PDF出力").ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=fPath & "\Sample.pdf"

「PDF出力」というシートの印刷範囲をPDF形式（Type:=xlTypePDF）で保存しています。
保存先とファイル名は、パスで指定します。
こちらでは以下のように、Excelファイルと同じ配下に「Sample.pdf」という名前で保存しています。

Filename:=fPath & "\Sample.pdf"

以上のコードを実行することで、以下のようにPDFファイルを作成することができます。

ただこのままでは、セルC2の値を手動で変更する必要があります。
そこで、次のように修正します。

3. コードの記述（引数の設定）

以下のように修正します。

Sub ExportToPDF(fName As String)
    
    Dim fPath As String
    fPath = ThisWorkbook.Path
    
    Worksheets("PDF出力").ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=fPath & "\" & fName & ".pdf"
    
End Sub

では、修正点について解説していきます。

Sub ExportToPDF(fName As String)
    …
        Filename:=fPath & "\" & fName & ".pdf"

ファイル名を「Sample.pdf」から「引数に指定した好みの名前」で保存できるように修正しています。
後は、セルC2の値を変更して、セルのC2の値を「ExportToPDF」の引数に指定して実行するという処理を繰り返します。

そこで、次のようなプロシージャを用意します。

4. コードの記述（差し込み実行）

以下のプロシージャを用意します。

Sub ExportAll()
    
    Dim ws As Worksheet
    Set ws = Worksheets("PDF出力")
    
    Dim val As String
    
    val = "A"
    ws.Range("C2").Value = val
    Call ExportToPDF(val)
    
    val = "B"
    ws.Range("C2").Value = val
    Call ExportToPDF(val)
    
    val = "C"
    ws.Range("C2").Value = val
    Call ExportToPDF(val)
    
End Sub

では、コードについて解説していきます。

    Dim ws As Worksheet
    Set ws = Worksheets("PDF出力")

「ws」という変数（入れ物）を用意し、「PDF出力」シートの情報を「ws」に割り当てています。

    Dim val As String
    
    val = "A"
    ws.Range("C2").Value = val
    Call ExportToPDF(val)

「val」という変数（入れ物）を用意し、「ws」シートのセルC2に入力したい１つ目の値（仮：A）を「val」に格納しています。
そして、「val」の値を「ws」シートのセルC2に格納した上で、最初に記述した「ExportToPDF」に「val」の値を渡して実行しています。

これで、１つ目のPDFファイルが作成されます。

    val = "B"
    ws.Range("C2").Value = val
    Call ExportToPDF(val)
    
    val = "C"
    ws.Range("C2").Value = val
    Call ExportToPDF(val)

こちらは、先ほどの処理と同様に、「B」という値、「C」という値でも実行しています。

5. 完成

以上の手順で完成です。
作成した「ExportAll」を実行するだけで、以下のように複数のPDFファイルが出力されます。

繰り返し似たような処理を実行する場合は、重複する処理の内容を１つのプロシージャ（ExportToPDF）にまとめておくことで、処理全体が見やすく保守しやすいコードになります。

▼サンプルファイル▼

定期的に送られてくる複数のExcelファイルを、以下のようにまとめるのは、手作業だと大変です。

ということで、「指定したフォルダ内のExcelファイルから、必要なデータを自動で抽出してまとめる仕組み」の実現方法について解説していきます。

※こちらで実現したファイルは、記事の最後にて配布しています。

1. 開発準備

今回は、フォルダのパスをインプットボックスに入力してから実行するだけで、以下のシートに、該当する項目のデータを抽出する仕組みを、VBAを活用して実現します。

まずは、[開発]タブから[マクロ]を選択し、表示された画面の[マクロ名]に好みの名前（例：ImportSalesData）を入力して、[作成]を選択します。

以上の手順で、入力したマクロ名のプロシージャが表示されるため、そのプロシージャを活用します。
「Option Explicit」は、VBE（エディタ画面）の設定内容次第では表示されません。「Option Explicit」についての解説はこちらでは省略します。

2. コードの記述

以下のコードを記述します。

Sub ImportSalesData()
    
    Dim fP As String, fN As String
    fP = InputBox("フォルダパス")
    fN = Dir(fP & "\*.xlsx")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    Dim r As Long, c As Long
    r = 3
    
    Do While fN <> ""
        With Workbooks.Open(fP & "\" & fN)
            For c = 2 To 5
                ws.Cells(r, c).Value = _
                    .Worksheets(1).Cells(c, "C").Value
            Next c
            .Close
        End With
        r = r + 1
        fN = Dir()
    Loop
    
End Sub

では、コードについて解説していきます。

    Dim fP As String, fN As String
    fP = InputBox("フォルダパス")
    fN = Dir(fP & "\*.xlsx")

対象のフォルダのパスを格納する用の変数「fP」と、そのフォルダ内の１つのExcelファイルの名前を格納する用の変数「fN」を用意しています。

そして、「fP」には、インプットボックスに入力した値（対象のフォルダのパスを入力する想定）を格納し、「fN」には、その「fP」のフォルダの中に格納されている１つ目のファイル名を格納しています。
「fP & “\*.xlsx”」で、「フォルダパス\*.xlsx」というファイルのパスを作成し、Dirで該当するファイルの名前を取得しています。
※「*」は０文字以上の任意の文字という意味です。

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    Dim r As Long, c As Long
    r = 3

シート情報を格納する用の変数「ws」を用意し、抽出先のファイル（コードを記述している自分自身のファイル）の先頭のシート情報を格納しています。

次に、対象のシート（ws）に、抽出内容を入力するセルの位置を指定するための行番号と列番号を格納する用の変数「r：rowの略、c：columnの略」を用意しています。
行番号を格納する用の変数「r」には、予め「3」を格納しています。

    Do While fN <> ""
        '省略
        fN = Dir()
    Loop

指定したフォルダ内に該当するファイルが見つからない場合は、「fN」が空になります。
そのため、ここでは「fN」が空でない場合に、「Do」から「Loop」の中を実行するようにしています。

最後に「fN = Dir()」と記述することで、「fN」の中に次のファイル名が格納されます。
次のファイルが存在しない場合は、ファイル名を取得できないため、「fN」が空になります。

そして、再度、「Do」に戻り、「fN」が空になるまで繰り返して実行されます。

        With Workbooks.Open(fP & "\" & fN)
            For c = 2 To 5
                ws.Cells(r, c).Value = _
                    .Worksheets(1).Cells(c, "C").Value
            Next c
            .Close
        End With
        r = r + 1

繰り返しの中で行う処理です。
「Workbooks.Open(fP & “\” & fN)」で、指定したフォルダ（fP）内の対象のファイル名（fN）のファイルを開いています。
「With」で指定することによって、「With」から「End With」の中で「.」から記述したコードは、開いたファイルの情報に対しての処理になります。

「For」から「Next」の中を、変数「c」の値を２から５まで順番に変化させて繰り返し実行しています。
「２から５」というのは、抽出先の表のB列からE列までの列番号になります。

「For」の中で、抽出先のシートの「r」行目「c」列目のセルに、開いたブックの先頭のシートの「c」行目C列にある値を入力しています。

抽出先のシートの２列目には、抽出元のシートの２行目、
抽出先のシートの３列目には、抽出元のシートの３行目、
という感じに行番号と列番号が、行と列が逆の関係にあるため、上記のような処理になります。

１つのファイルの内容の入力ができたら、次のファイルに移る前に「r = r + 1」で行番号に１を加えています。

3. 完成

以上の内容で実現できます。
実行する際は、[開発]タブの[マクロ]を選択し、表示された画面から開発したマクロ名を選択して[実行]を選択します。

次に、表示されたインプットボックスに、抽出元のファイルが格納されたフォルダのパスを入力して確定します。

これでだけで、以下のように、指定したフォルダ内のすべてのExcelファイルの内容を抽出することができます。

▼サンプルファイル▼