VBAマクロを自動作成する無料アプリ

VBAコードの知識不要😊ChatGPTで機能を追加

MENU

【ノーコード】複数シートのデータを、縦にコピーし、1枚にまとめる(複数シートから転記する)

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

例として「複数シートのデータを、縦方向にコピーし、1枚にまとめる」VBAマクロを作成します。

事例 各シートのデータを、1枚のシートにまとめます

1枚のシートに、データをまとめました。

できました😃

アプリの設定

アプリの設定です。

アプリのトップページ 

⇒▼シート 

⇒【ツール】複数シートのデータを1枚のシートにまとめる

 

【ポイント】

 処理するシートのうち、「貼り付け先のシート」は自動で除外します。

 処理する範囲に空白行があるときは、最終行までを選ばずに、セル範囲を指定してください。

■   シート名をデータの左横につけるときは、左の列を空けてください。

 数式を、値で上書きできます。

表示されるVBAコード 

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

 

VBAコードを見る

 

Sub デモ_シートオプションあり() '複数シートを1枚
'一覧シートがあるか調べる
Dim 貼付シート As Worksheet, あり As Boolean
For Each 貼付シート In Worksheets
    If 貼付シート.Name = "一覧" Then
        あり = True
        Exit For
    End If
Next 貼付シート
' "一覧"が存在しなければメッセージを表示して処理を終了
If あり = False Then
    MsgBox "貼り付けシートがありません。終了します。", vbInformation, "エラー"
    Exit Sub
End If
'シートの内容クリア
Worksheets("一覧").Select
Range("B1").CurrentRegion.Clear
'各シートで処理をする
Dim 枚数 As Long, シート As Worksheet
枚数 = 0
For Each シート In Worksheets
    Call デモ(シート, 枚数)
Next シート
End Sub

 

Sub デモ(シート As Worksheet, 枚数 As Long) '複数シートを1枚
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止
Dim 右下セル As String, セル範囲 As String, 貼り付け先範囲 As Range, 貼り付け先セル As String
'シートが"一覧"ではない場合、"一覧"にデータを貼り付ける
If シート.Name <> "一覧" Then
    枚数 = 枚数 + 1
    'コピーする範囲を取得
    シート.Select
Dim 最終行 As Long '表の最終行を決定
最終行 = Cells(Rows.Count, Range("A1").Column).End(xlUp).Row
セル範囲 = "a1" & ":" & Cells(最終行, Range("c1").Column).Address(False, False)

    If 枚数 = 1 Then
        シート.Range(セル範囲).Copy Worksheets("一覧").Range("B1")
        Worksheets("一覧").Range("B1").Offset(0, -1).Value = シート.Name
    Else
        '表全体の末端を右下セルとして取得
        Worksheets("一覧").Select
        Range("B1").CurrentRegion.Select
        右下セル = Cells(Selection.Row + Selection.Rows.Count - 1, Range("B1").Column).Address(False, False)
        シート.Range(セル範囲).Copy Worksheets("一覧").Range(右下セル).Offset(1, 0)
        Worksheets("一覧").Range(右下セル).Offset(1, -1).Value = シート.Name
    End If
End If
Worksheets("一覧").Activate
Application.DisplayAlerts = True   ' 警告表示を再開
Application.ScreenUpdating = True  ' 画面描画を再開
End Sub

 

ChatGPTで修正

あなたが自動化したい内容と事例が少し異なる場合は、無料で使えるマイクロソフトの「BingAIチャット」でコードを修正します。とても簡単です!

アプリはこちらから↓↓↓↓