Option Explicit
Public Sub ファイル統合()
Const Folder1 As String = "d:\goo\data7\temp" '契約管理表格納フォルダ
Const Folder2 As String = "d:\goo\data7" '顧客データ格納フォルダ
Dim today As Date '本日
Dim wdate As Date
Dim i As Long
Dim sbname(2) As String '過去3箇月のブック名
Dim tbname As String '契約管理表(該当月)ブック名
Dim msg As String
Dim wb1 As Workbook '契約管理表(該当月)
Dim wb2 As Workbook '顧客データ
Dim sh1 As Worksheet '契約管理表 Sheet1
Dim sh2 As Worksheet '顧客データ Sheet1
Dim maxrow1 As Long '契約管理表 Sheet1 最大行
Dim maxrow2 As Long '顧客データ Sheet1 最大行
Dim row1 As Long '契約管理表 Sheet1 行番号
Dim row2 As Long '顧客データ Sheet1 行番号
today = Date
tbname = Month(today) & "月契約管理表"
msg = ""
For i = 0 To 2
wdate = DateAdd("m", (i - 3), today)
sbname(i) = "顧客データ(" & Year(wdate) & "年" & Month(wdate) & "月分)"
msg = msg & vbLf & sbname(i)
Next
msg = msg & vbLf & "を" & vbLf & tbname & vbLf & "にまとめます"
If MsgBox(msg, vbOKCancel) <> vbOK Then Exit Sub
Set wb1 = Workbooks.Open(Folder1 & "\" & tbname & ".xlsx")
Set sh1 = wb1.Worksheets("Sheet1")
maxrow1 = sh1.Cells(Rows.Count, "B").End(xlUp).Row 'B列の最大行取得
If maxrow1 > 1 Then
sh1.Range("B2:C" & maxrow1).ClearContents
End If
row1 = 2
'過去3か月分を集計
For i = 0 To 2
Set wb2 = Workbooks.Open(Folder2 & "\" & sbname(i) & ".xlsx")
Set sh2 = wb2.Worksheets("Sheet1")
maxrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row 'A列の最大行取得
For row2 = 2 To maxrow2
'B~AL列へA~AK列を転送
sh1.Cells(row1, "B").Resize(, 37).Value = sh2.Cells(row2, "A").Resize(, 37).Value
row1 = row1 + 1
Next
wb2.Saved = True
wb2.Close
Next
'ソート
If row1 > 2 Then
sh1.Range("B2:AL" & row1 - 1).Sort key1:=Range("B2"), Order1:=xlAscending, key2:=Range("C2"), Order1:=xlAscending, Header:=xlNo
End If
wb1.Save
wb1.Close
MsgBox ("完了")
End Sub
T3B0aW9uIEV4cGxpY2l0ClB1YmxpYyBTdWIg44OV44Kh44Kk44Or57Wx5ZCIKCkKICAgIENvbnN0IEZvbGRlcjEgQXMgU3RyaW5nID0gImQ6XGdvb1xkYXRhN1x0ZW1wIiAgICflpZHntITnrqHnkIbooajmoLzntI3jg5Xjgqnjg6vjg4AKICAgIENvbnN0IEZvbGRlcjIgQXMgU3RyaW5nID0gImQ6XGdvb1xkYXRhNyIgICAgICAgICfpoaflrqLjg4fjg7zjgr/moLzntI3jg5Xjgqnjg6vjg4AKICAgIERpbSB0b2RheSBBcyBEYXRlICAgJ+acrOaXpQogICAgRGltIHdkYXRlIEFzIERhdGUKICAgIERpbSBpIEFzIExvbmcKICAgIERpbSBzYm5hbWUoMikgQXMgU3RyaW5nICAgICAn6YGO5Y6777yT566H5pyI44Gu44OW44OD44Kv5ZCNCiAgICBEaW0gdGJuYW1lIEFzIFN0cmluZyAgICAgICAgJ+Wlkee0hOeuoeeQhuihqO+8iOipsuW9k+aciO+8ieODluODg+OCr+WQjQogICAgRGltIG1zZyBBcyBTdHJpbmcKICAgIERpbSB3YjEgQXMgV29ya2Jvb2sgICAgICAgICAn5aWR57SE566h55CG6KGo77yI6Kmy5b2T5pyI77yJCiAgICBEaW0gd2IyIEFzIFdvcmtib29rICAgICAgICAgJ+mhp+WuouODh+ODvOOCvwogICAgRGltIHNoMSBBcyBXb3Jrc2hlZXQgICAgICAgICflpZHntITnrqHnkIbooaggU2hlZXQxCiAgICBEaW0gc2gyIEFzIFdvcmtzaGVldCAgICAgICAgJ+mhp+WuouODh+ODvOOCvyBTaGVldDEKICAgIERpbSBtYXhyb3cxIEFzIExvbmcgICAgICAgICAn5aWR57SE566h55CG6KGoIFNoZWV0MSDmnIDlpKfooYwKICAgIERpbSBtYXhyb3cyIEFzIExvbmcgICAgICAgICAn6aGn5a6i44OH44O844K/IFNoZWV0MSDmnIDlpKfooYwKICAgIERpbSByb3cxIEFzIExvbmcgICAgICAgICAgICAn5aWR57SE566h55CG6KGoIFNoZWV0MSDooYznlarlj7cKICAgIERpbSByb3cyIEFzIExvbmcgICAgICAgICAgICAn6aGn5a6i44OH44O844K/IFNoZWV0MSDooYznlarlj7cKICAgIHRvZGF5ID0gRGF0ZQogICAgdGJuYW1lID0gTW9udGgodG9kYXkpICYgIuaciOWlkee0hOeuoeeQhuihqCIKICAgIG1zZyA9ICIiCiAgICBGb3IgaSA9IDAgVG8gMgogICAgICAgIHdkYXRlID0gRGF0ZUFkZCgibSIsIChpIC0gMyksIHRvZGF5KQogICAgICAgIHNibmFtZShpKSA9ICLpoaflrqLjg4fjg7zjgr/vvIgiICYgWWVhcih3ZGF0ZSkgJiAi5bm0IiAmIE1vbnRoKHdkYXRlKSAmICLmnIjliIbvvIkiCiAgICAgICAgbXNnID0gbXNnICYgdmJMZiAmIHNibmFtZShpKQogICAgTmV4dAogICAgbXNnID0gbXNnICYgdmJMZiAmICLjgpIiICYgdmJMZiAmIHRibmFtZSAmIHZiTGYgJiAi44Gr44G+44Go44KB44G+44GZIgogICAgSWYgTXNnQm94KG1zZywgdmJPS0NhbmNlbCkgPD4gdmJPSyBUaGVuIEV4aXQgU3ViCiAgICBTZXQgd2IxID0gV29ya2Jvb2tzLk9wZW4oRm9sZGVyMSAmICJcIiAmIHRibmFtZSAmICIueGxzeCIpCiAgICBTZXQgc2gxID0gd2IxLldvcmtzaGVldHMoIlNoZWV0MSIpCiAgICBtYXhyb3cxID0gc2gxLkNlbGxzKFJvd3MuQ291bnQsICJCIikuRW5kKHhsVXApLlJvdyAgICAnQuWIl+OBruacgOWkp+ihjOWPluW+lwogICAgSWYgbWF4cm93MSA+IDEgVGhlbgogICAgICAgIHNoMS5SYW5nZSgiQjI6QyIgJiBtYXhyb3cxKS5DbGVhckNvbnRlbnRzCiAgICBFbmQgSWYKICAgIHJvdzEgPSAyCiAgICAn6YGO5Y6777yT44GL5pyI5YiG44KS6ZuG6KiICiAgICBGb3IgaSA9IDAgVG8gMgogICAgICAgIFNldCB3YjIgPSBXb3JrYm9va3MuT3BlbihGb2xkZXIyICYgIlwiICYgc2JuYW1lKGkpICYgIi54bHN4IikKICAgICAgICBTZXQgc2gyID0gd2IyLldvcmtzaGVldHMoIlNoZWV0MSIpCiAgICAgICAgbWF4cm93MiA9IHNoMi5DZWxscyhSb3dzLkNvdW50LCAiQSIpLkVuZCh4bFVwKS5Sb3cgICAgJ0HliJfjga7mnIDlpKfooYzlj5blvpcKICAgICAgICBGb3Igcm93MiA9IDIgVG8gbWF4cm93MgogICAgICAgICAgICAnQu+9nkFM5YiX44G4Qe+9nkFL5YiX44KS6Lui6YCBCiAgICAgICAgICAgIHNoMS5DZWxscyhyb3cxLCAiQiIpLlJlc2l6ZSgsIDM3KS5WYWx1ZSA9IHNoMi5DZWxscyhyb3cyLCAiQSIpLlJlc2l6ZSgsIDM3KS5WYWx1ZQogICAgICAgICAgICByb3cxID0gcm93MSArIDEKICAgICAgICBOZXh0CiAgICAgICAgd2IyLlNhdmVkID0gVHJ1ZQogICAgICAgIHdiMi5DbG9zZQogICAgTmV4dAogICAgJ+OCveODvOODiAogICAgSWYgcm93MSA+IDIgVGhlbgogICAgICAgIHNoMS5SYW5nZSgiQjI6QUwiICYgcm93MSAtIDEpLlNvcnQga2V5MTo9UmFuZ2UoIkIyIiksIE9yZGVyMTo9eGxBc2NlbmRpbmcsIGtleTI6PVJhbmdlKCJDMiIpLCBPcmRlcjE6PXhsQXNjZW5kaW5nLCBIZWFkZXI6PXhsTm8KICAgIEVuZCBJZgogICAgd2IxLlNhdmUKICAgIHdiMS5DbG9zZQogICAgTXNnQm94ICgi5a6M5LqGIikKRW5kIFN1Ygo=