【excelマクロVBA】表の集計・転記マクロの改造点について
以前、こちらのカテゴリーで重複をチェックしてその行を削除し表を整頓するマクロとしてプログラムを教えて頂きました。
（資材受け入れシート） → （Sheet2）
受入日 品名 Lot 数量 受入日 品名 Lot 数量
7/7 A BNR32 10 7/8 A BNR32 15
7/8 A BNR32 5 7/10 B SW200 14
7/10 B SW200 2 → 7/7 B AE860 4
7/7 B AE860 4 7/9 C GD300 11
7/8 B SW200 12 7/7 C DC200 7
7/9 C GD300 10
7/7 C GD300 1
7/7 C DC200 7
プログラムの内容は、
Sub test()
Dim strSql As String
Dim cnXL As Object
Dim rsXL As Object
Const adOpenForwardOnly = 0
Sheets("資材受け入れシート").Range("A1:D1").Copy
Sheets("資材受け入れシート").Paste Destination:=Worksheets("Sheet2").Range("A1:D1")
Application.CutCopyMode = False
Set cnXL = CreateObject("ADODB.Connection")
Set rsXL = CreateObject("ADODB.Recordset")
With cnXL
.Provider = "MSDASQL"
.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=" & ThisWorkbook.FullName & "; ReadOnly=True;"
.Open
End With
strSql = "select max(受入日) as 日付,品名,Lot,sum(数量) as 合計" _
& " from [資材受け入れシート$]" _
& " group by 品名,Lot order by max(受入日),品名,Lot"
Debug.Print strSql
rsXL.Open strSql, cnXL, adOpenForwardOnly
Worksheets("sheet2").Cells(2, 1).CopyFromRecordset rsXL
Worksheets("sheet2").Columns("A:A").NumberFormatLocal = "m/d"
rsXL.Close: Set rsXL = Nothing
cnXL.Close: Set cnXL = Nothing
MsgBox "Sheet2に出力しました"
End Sub
と記述されており、正常に動作いたしました。
ところが、会社から受入日，品名，Lot，数量だけでなく、納入業者，賞味期限，担当者の項目（列）を追加し転記できるように欲しいと命じられました。業務の都合上、列の順番は受入日，＜納入業者＞，品名，Lot，＜賞味期限＞，数量，＜担当者＞の順番で挿入し、追加した3項目については計算させる必要は無く、転記だけさせたいと考えています。上のプログラムを元に改造を試みたのですが、転記が上手くできません。どこの部分にどのように記述・変更したら良いのかが分りません。どなたかご存知の方、お教え願えませんでしょうか？表の作成までにもう少しというところで躓いてしまい頭を悩ませております。初歩的な質問かもしれませんが、宜しくお願い致します。
お礼
なんとか、上記のアドバイス通りやったら、完成することができました。 ありがとうございました。