'こんなカンジでいかがでしょうか
Option Explicit
Dim shDataA As Worksheet
Dim shDataB As Worksheet
Dim shDataC As Worksheet
Dim PutRow As Long
'//------------main
Sub main()
Dim RowCnt As Long
Set shDataA = ThisWorkbook.Sheets("DataA")
Set shDataB = ThisWorkbook.Sheets("DataB")
Set shDataC = ThisWorkbook.Sheets("DataC")
shDataC.Cells.ClearContents
shDataC.Cells(1, 1).Value = "入荷日"
shDataC.Cells(1, 2).Value = "商品番号"
shDataC.Cells(1, 3).Value = "商品名"
shDataC.Cells(1, 4).Value = "巣量"
shDataC.Cells(1, 5).Value = "金額"
shDataC.Cells(1, 6).Value = "販売数"
RowCnt = 2
PutRow = 1
Do
If shDataA.Cells(RowCnt, 1).Value = "" Then Exit Do
PutRow = PutRow + 1
shDataA.Rows(RowCnt).Copy shDataC.Rows(PutRow)
Tenki shDataA.Cells(RowCnt, 2).Value
RowCnt = RowCnt + 1
Loop
End Sub
'//------------Sub
Sub Tenki(SNum As Long)
Dim RowCnt As Long
Dim HitFlg As Boolean
RowCnt = 2
HitFlg = False
Do
If shDataB.Cells(RowCnt, 1).Value = "" Then Exit Do
If shDataB.Cells(RowCnt, 2).Value = SNum Then
HitFlg = True
ElseIf ((shDataB.Cells(RowCnt, 2).Value <> "") And _
(shDataB.Cells(RowCnt, 2).Value <> SNum)) Then
HitFlg = False
End If
If ((HitFlg = True) And _
(shDataB.Cells(RowCnt, 2).Value = "")) Then
PutRow = PutRow + 1
shDataC.Cells(PutRow, 3).Value = shDataB.Cells(RowCnt, 3).Value
shDataC.Cells(PutRow, 6).Value = shDataB.Cells(RowCnt, 4).Value
End If
RowCnt = RowCnt + 1
Loop
End Sub
お礼
毎月集計するものなので、VBAで回答いただけてとても助かりました。 こちらに手を加えて使用させていただきます。 ありがとうございました。