VBAで会社名ごとにデータを抽出し新しいファイルを作成する方法

VBA（Visual Basic for Applications）を使用して、Excelの特定の列に基づいてデータを抽出し、新しいファイルを自動で作成する方法を学びます。この記事では、会社名ごとにデータを抽出し、指定したフォルダに保存するマクロを作成する方法を解説します。

問題の概要
必要なVBAコードの作成
VBAコードの動作確認
エラー対処方法
まとめ

問題の概要

ExcelのA列に会社名が記載されており、その会社名ごとにA列からS列までのデータをコピーして、新しいファイルを作成する方法を学びます。新しいファイルの名前は「会社名_今日の日付」という形式にし、指定の場所に格納することが目標です。

以下の手順をVBAマクロで実現します。

必要なVBAコードの作成

このマクロは、各会社名ごとにデータをコピーし、新しいファイルを作成するという処理を行います。以下はそのVBAコードの一例です。

Sub ExportDataByCompany()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim companyName As String
    Dim newWorkbook As Workbook
    Dim newSheet As Worksheet
    Dim todayDate As String
    Dim savePath As String

    ' シートの設定
    Set ws = ThisWorkbook.Sheets("Sheet1") ' データがあるシート名を指定

    ' 最後の行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' 今日の日付を取得
    todayDate = Format(Date, "yyyymmdd")

    ' 各会社名ごとに処理
    For i = 2 To lastRow
        companyName = ws.Cells(i, 1).Value ' A列の会社名を取得

        ' 新しいワークブックを作成
        Set newWorkbook = Workbooks.Add
        Set newSheet = newWorkbook.Sheets(1)

        ' 会社名ごとにA列からS列までをコピー
        ws.Range(ws.Cells(i, 1), ws.Cells(i, 19)).Copy Destination:=newSheet.Range("A1")

        ' 新しいファイルを保存
        savePath = "C:\Users\YourUsername\Documents\" & companyName & "_" & todayDate & ".xlsx"
        newWorkbook.SaveAs savePath
        newWorkbook.Close False
    Next i

    MsgBox "処理が完了しました！"
End Sub

このコードは、以下の手順で動作します。