Zenn
Open2

VBAを初めて触ってみる。

Excel
初心者
VBA
ピン留めされたアイテム
Ta2shiTa2shi

これ見て！

Sub CopyDataToNewSheets()
    Dim srcSheet As Worksheet
    Dim newSheet As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim i As Long, j As Long
    Dim newSheetIndex As Integer
    
    ' 元のシートを取得
    Set srcSheet = ThisWorkbook.Sheets(1)
    
    ' 最終行と最終列を取得
    lastRow = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row
    lastCol = srcSheet.Cells(1, srcSheet.Columns.Count).End(xlToLeft).Column
    
    ' 新しいシートを列の数ごとに作成してデータをコピー
    For i = 1 To lastCol
        ' 新しいシートを作成
        Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        newSheetIndex = newSheet.Index
        
        ' シート名を設定
        newSheet.Name = srcSheet.Cells(1, i).Value
        
        ' データをコピー
        For j = 1 To lastRow
            newSheet.Cells(j, 1).Value = srcSheet.Cells(j, i).Value
        Next j
    Next i
    
    MsgBox "データのコピーが完了しました。", vbInformation
End Sub
Ta2shiTa2shi

エクセルのVBAを初めて使ってみる。

お友達の手伝い。

下記、プロンプト備忘録

User

User
私は、エクセルを用いて作業効率化を図ろうとしています。
そして、あなたはエクセルのVBAに関するプロフェッショナルです。
下記の条件、必要な機能を聞いて、VBAプログラムを作成してください。

私が作りたいマクロ機能として、
先頭のシートの列ごとの値を、新規作成したシートのA１にコピーするプログラムを考えてください。
つまり、先頭シートの内容がA〜F列まである場合は、新規シートが６シートできることになります。

また、出力するプログラムをより良くするために必要な情報があれば逆質問を私にしてください。

ChatGPT

ChatGPT
了解しました。まずはいくつかの情報を確認させてください。

新規シートにコピーする際、元のシートのデータはヘッダーを含めてすべてコピーするのでしょうか？
新規シートの名前は何にしますか？自動的に番号付けする必要がありますか？
新規シートを作成した後、そのシートにデータをコピーする際、どのような書式（フォント、セルの幅、列の幅など）を保持する必要がありますか？
コピーする際に空白のセルも含める必要がありますか？
その他、特別な条件や要件はありますか？

User

User
１、ヘッダーも含めてコピーしてください。
２、ヘッダーの値をシート名にしてください。
３、コピー元の値のみを保持してください。
４、含めてください。
５、特にありません。しかし、あなたが思う保守的なコード、処理が必要であれば追加してください。しかし、シンプルなコード、機能担っていることが理想です。

ChatGPT

ChatGPT
了解しました。以下が要件に基づいたVBAコードです。このコードは、先頭のシートからデータを取得し、新しいシートを作成してそのデータをコピーします。

Sub CopyDataToNewSheet()
    Dim srcSheet As Worksheet
    Dim newSheet As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim i As Long, j As Long
    
    ' 元のシートを取得
    Set srcSheet = ThisWorkbook.Sheets(1)
    
    ' 最終行と最終列を取得
    lastRow = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row
    lastCol = srcSheet.Cells(1, srcSheet.Columns.Count).End(xlToLeft).Column
    
    ' 新しいシートを作成
    Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    
    ' シート名をヘッダーの値に設定
    newSheet.Name = srcSheet.Cells(1, 1).Value
    
    ' データをコピー
    For i = 1 To lastCol
        For j = 1 To lastRow
            newSheet.Cells(j, i).Value = srcSheet.Cells(j, i).Value
        Next j
    Next i
    
    ' 列の幅を調整
    newSheet.Columns.AutoFit
    
    MsgBox "データのコピーが完了しました。", vbInformation
End Sub

このコードは、以下のような処理を行います。

先頭のシート（インデックス1）からデータを取得します。
元のシートの最終行と最終列を取得します。
新しいシートを作成し、そのシートの名前を元のシートのヘッダーの値に設定します。
データをコピーします。ヘッダーを含め、すべてのデータを新しいシートにコピーします。
新しいシートの列の幅を自動調整します。
最後にメッセージボックスで処理の完了を通知します。
このコードはシンプルで保守的な処理を行っていますが、問題があればお知らせください。

User

User
ありがとう、上記のマクロを実行した結果、新規シートが作成されました。
しかし、私が実現したい処理は、列の数ごとの新規シートが出力されるべきです。
例えば、先頭シートのA列の値を新規シート０１のA1セルにコピー
次に、先頭シートのB列の値を新規シート０２のA1セルにコピー
といったような処理が実行されるマクロプログラムを再検討してください。

ChatGPT

ChatGPT
ChatGPT
了解しました。そのような処理を行うために、以下のようにコードを変更します。

Sub CopyDataToNewSheets()
    Dim srcSheet As Worksheet
    Dim newSheet As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim i As Long, j As Long
    Dim newSheetIndex As Integer
    
    ' 元のシートを取得
    Set srcSheet = ThisWorkbook.Sheets(1)
    
    ' 最終行と最終列を取得
    lastRow = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row
    lastCol = srcSheet.Cells(1, srcSheet.Columns.Count).End(xlToLeft).Column
    
    ' 新しいシートを列の数ごとに作成してデータをコピー
    For i = 1 To lastCol
        ' 新しいシートを作成
        Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        newSheetIndex = newSheet.Index
        
        ' シート名を設定
        newSheet.Name = "新規シート_" & Format(i, "00")
        
        ' データをコピー
        For j = 1 To lastRow
            newSheet.Cells(j, 1).Value = srcSheet.Cells(j, i).Value
        Next j
    Next i
    
    MsgBox "データのコピーが完了しました。", vbInformation
End Sub

このコードは、列の数ごとに新しいシートを作成し、それぞれのシートに対応する列のデータをコピーします。新しいシートの名前は、"新規シート_01"、"新規シート_02" などの形式で設定されます。

このコードを実行すれば、ご希望の処理が実現できるはずです。

User

User
ありがとう、欲しい機能に近づいてきました。
最後の修正として、新規シートの命名をコピーするデータのヘッダーをそのまま、シート名としてください。

ChatGPT

ChatGPT
了解しました。新しいシートの名前をコピーするデータのヘッダーに設定するために、以下のようにコードを修正します。

Sub CopyDataToNewSheets()
    Dim srcSheet As Worksheet
    Dim newSheet As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim i As Long, j As Long
    Dim newSheetIndex As Integer
    
    ' 元のシートを取得
    Set srcSheet = ThisWorkbook.Sheets(1)
    
    ' 最終行と最終列を取得
    lastRow = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row
    lastCol = srcSheet.Cells(1, srcSheet.Columns.Count).End(xlToLeft).Column
    
    ' 新しいシートを列の数ごとに作成してデータをコピー
    For i = 1 To lastCol
        ' 新しいシートを作成
        Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        newSheetIndex = newSheet.Index
        
        ' シート名を設定
        newSheet.Name = srcSheet.Cells(1, i).Value
        
        ' データをコピー
        For j = 1 To lastRow
            newSheet.Cells(j, 1).Value = srcSheet.Cells(j, i).Value
        Next j
    Next i
    
    MsgBox "データのコピーが完了しました。", vbInformation
End Sub

この修正により、新しいシートの名前がコピーするデータのヘッダーに設定されるようになります。コードを実行すると、ご希望の動作が得られるはずです。