2024-03-08

【ﾉｰｺｰﾄﾞVBA】一覧表から、複数シートの同一セルに異なる値を入力する（前月残高転記）

エクセルVBAマクロを自動作成する無料アプリです。

例として「一覧表から、複数シートの同一セルに異なる値を入力する」VBAマクロを作成します。

事例　前月残高転記
ChatGPTで修正
アプリはこちらから↓↓↓↓

事例　前月残高転記

原本を除いたすべてのシートデータを転記し、前月データを削除しました。

出来ました😁

【ポイント】
総括表の各行に異なる値を入れることで、各シートに異なる値が入力されます。
もし、各行が同じ値であれば、各シートに同じ値が入力されます。

アプリの設定

アプリへのリンク
　⇒◇一覧表から、複数シートの同一セルに異なる値を入力する

【ポイント】

■「事前に転記先セルを空白に」に☑すると、転記の無い既存シートの既存データが空欄になります。

■既存シートのセルを空白にするに☑すると、指定したセル範囲の既存データが空欄になります。

■　一つ目のシートが終わると、次のシートを順次処理します。

表示されるVBAコード

アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。

VBAコードを見る

Sub 前月残高転記() '一覧表から、複数シートの同一セルに値を転記する
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False ' 警告表示を停止
Dim シート As Worksheet
'除外シート
Dim 除外辞書 As Object, 配列 As Variant, 除外配列 As Variant, 数 As Long
Set 除外辞書 = CreateObject("Scripting.Dictionary")
'除外配列に、除外対象を代入
配列 = Split(",総括表,原本", ",")
除外配列 = 配列
For 数 = 0 To UBound(除外配列)
除外辞書.Add 除外配列(数), "除外"
Next 数
'シート名が除外辞書になければ
For Each シート In Worksheets
If Not 除外辞書.Exists(シート.Name) Then
シート.Range("a1").ClearContents
シート.Range("a2").ClearContents
シート.Range("e2").ClearContents
シート.Range("a4:d9").ClearContents
End If
Next シート
'各シートにセルの値を入れる
Dim 最終行 As Long, 行 As Long
Worksheets("総括表").Select
最終行 = Range("A2").End(xlDown).Row
For 行 = Range("A2").Row To 最終行
Set シート = Worksheets(Worksheets("総括表").Cells(行, Range("A2").Column).Value)
シート.Range("a1").Value = Worksheets("総括表").Cells(行, Range("A2").Column + 1).Value
シート.Range("a2").Value = Worksheets("総括表").Cells(行, Range("A2").Column + 2).Value
シート.Range("e2").Value = Worksheets("総括表").Cells(行, Range("A2").Column + 3).Value
'串刺し計算をする
Dim 串刺 As String
If 串刺 = "" Then
串刺 = シート.Name & "!E2"
Else
串刺 = 串刺 & "," & シート.Name & "!E2"
End If
Next 行
Sheets("総括表").Range("D8").Formula = "=SUM(" & 串刺 & ")"
Application.DisplayAlerts = True ' 警告表示を再開
Application.ScreenUpdating = True ' 画面描画を再開
End Sub