同じ値ごとに表の行を別シートにコピーするよwithChatGPTmakotoym

この説明は、ChatGPTで作成しています。

このVBAマクロは、選んだ列の中で同じ値を持つ行を、それぞれ別のシートに分けてコピーする処理をしてくれます。

どんな場面で使える？

たとえば、社員名簿があって「部署名」の列でフィルターをかけたい時に使えます。同じ部署の人たちの行が、部署ごとの新しいシートにコピーされて整理される、というわけです。

手順をやさしく説明します

1. マクロを実行するときに、分けたい列のセルを選んでおきます。
   たとえば「営業部」「人事部」などが入っている列のどれかのセルを選びます。

2. 選んだ列の、2行目から下のすべての値をチェックします。
   一番上の1行目は見出し（タイトル）として使うので、コピーには含まれません。

3. 重複を取り除いて、ひとつひとつの値（部署名など）を記録します。
   「営業部」「人事部」「総務部」など、同じ値は1回だけ記録されます。

4. それぞれの値ごとに、新しいシートを作ります。
   シートの名前は「★営業部」のように、★マーク＋値の名前になります。

5. 見出しの行（1行目）をコピーします。

6. 選んだ列の中で、今処理している値（たとえば営業部）と一致する行を全部探してコピーします。

ポイント！

• たくさんのデータがあっても、自動で分類できるのでとても便利です。

• 元のシートはそのまま残るので、安心して使えます。

• シートの名前が長かったり重複したりするとエラーになることがありますが、このマクロではエラーを無視するようにしています。

関連リンク

Sub 同じ値ごとに表の行を別シートにコピーするよwithChatGPT() Application.ScreenUpdating = False Dim sheetName As String Dim ws As Worksheet, newSheet As Worksheet Dim Col As Long, Rec As Long, i As Long Dim Master As Variant Dim dict As Object Dim key As Variant ' アクティブシートを設定 Set ws = ActiveSheet Col = ActiveCell.Column ' いまいる列 Rec = ws.Cells(ws.Rows.count, Col).End(xlUp).Row ' 選択列の2行目から最終行までをMasterに格納 Master = ws.Range(ws.Cells(2, Col), ws.Cells(Rec, Col)).Value ' 重複除外のためのDictionary Set dict = CreateObject("Scripting.Dictionary") For i = 1 To UBound(Master, 1) If Not dict.exists(CStr(Master(i, 1))) Then dict.Add CStr(Master(i, 1)), Nothing End If Next i ' Masterのユニークな値ごとに処理 For Each key In dict.Keys sheetName = key ' アクティブシートの左に新規シートを追加 Set newSheet = Sheets.Add(Before:=ws) On Error Resume Next newSheet.Name = "★" & sheetName On Error GoTo 0 ' 見出しコピー ws.Rows(1).Copy Destination:=newSheet.Cells(1, 1) ' 対象の値に一致する行をコピー Dim rowIndex As Long: rowIndex = 2 For i = 2 To Rec If ws.Cells(i, Col).Value = key Then ws.Rows(i).Copy Destination:=newSheet.Cells(rowIndex, 1) rowIndex = rowIndex + 1            End If        Next i    Next key    Application.ScreenUpdating = TrueEnd Sub

関連ハッシュタグ（キーワード20個）

#excel #できること #vba #マクロ作成 #データ整理 #自動化 #シート分割 #条件抽出 #辞書オブジェクト #vba初心者 #業務効率化 #excelvba勉強中 #行コピー #シート追加 #新規シート作成 #列で分類 #部署別管理 #エクセル自動処理 #アクティブシート #行抽出

英語翻訳（English Translation）

Copy Rows to Separate Sheets by Same Value with ChatGPT

This explanation is created using ChatGPT.

This VBA macro automatically copies rows from a selected column in Excel into new sheets based on unique values in that column.

When can I use it?

For example, if you have a list of employees and want to separate them by department (like “Sales”, “HR”), this macro will copy each group into a separate sheet.

Step-by-step Explanation

1. Before running the macro, select a cell in the column you want to classify.
   For example, any cell in the “Department” column.

2. The macro reads all the values from row 2 downwards in the selected column.
   Row 1 is treated as a header.

3. It removes duplicates and collects each unique value (e.g., department names).

4. For each unique value, it creates a new worksheet.
   The sheet name will be like “★Sales”.

5. The header row (row 1) is copied into the new sheet.

6. It then finds and copies all rows where the selected column matches the current value.

Key Points

• This is useful for organizing large datasets by category.

• The original sheet remains unchanged.

• Sheet name errors are ignored to avoid stopping the macro.

Related Links

Hashtags (20 Keywords)

#excel #できること #vba #マクロ作成 #データ整理 #自動化 #シート分割 #条件抽出 #辞書オブジェクト #vba初心者 #業務効率化 #excelvba勉強中 #行コピー #シート追加 #新規シート作成 #列で分類 #部署別管理 #エクセル自動処理 #アクティブシート #行抽出