エーアイトブイビーエーデシステムカイハツ20ジカン
Sub CreateSummarySheet()
Dim wsAllData As Worksheet
Dim wsOrderFormat As Worksheet
Dim lastRow As Long
Dim i As Long
Dim wsNew As Worksheet
Dim currentSheet As String
Dim productName As String
Dim quantity As Variant
Dim rowOffset As Long
Set wsAllData = ThisWorkbook.Sheets("全データ")
Set wsOrderFormat = ThisWorkbook.Sheets("フォーマット受注")
' 全データシートのデータを発送日ごとにまとめる
lastRow = wsAllData.Cells(wsAllData.Rows.Count, "D").End(xlUp).Row
For i = 2 To lastRow
' 商品名を取得
productName = wsAllData.Cells(i, "E").Value
' 数量を取得
quantity = wsAllData.Cells(i, "G").Value
' 発送日を取得
currentSheet = Format(wsAllData.Cells(i, "D").Value, "yyyymmdd")
' 発送日のシートが存在しない場合は作成
If Not SheetExists(currentSheet) Then
Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsNew.Name = currentSheet
' フォーマットの内容と書式をコピー
wsOrderFormat.Cells.Copy wsNew.Cells
' まとめた発送日をG3セルに入力
wsNew.Range("G3").Value = wsAllData.Cells(i, "D").Value
rowOffset = 0 ' 行のオフセットをリセット
Else
Set wsNew = ThisWorkbook.Sheets(currentSheet)
End If
' 商品名をフォーマットシートの指定セルに入力
wsNew.Range("B9").Offset(rowOffset, 0).Value = productName
' 数量をフォーマットシートの指定セルに入力
wsNew.Range("E9").Offset(rowOffset, 0).Value = quantity
rowOffset = rowOffset + 1 ' 行のオフセットをインクリメント
Next i
End Sub
Function SheetExists(sheetName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(sheetName)
On Error GoTo 0
SheetExists = Not ws Is Nothing
End Function
とりあえず、これが成果。
よくやった自分、ありがとうGPT。
だが、これは通過点。
此処から先はそんなに難しくないはず。
あとは、空白の行を削除して。
各シート複製して、ちょっと変更して。
完成の予定。
予定は未定。
つづく
この記事が気に入ったらサポートをしてみませんか?