| |
こんにちは。
>回答：ご指摘の通り確かにＥＸＣＥＬの行数制限を越えるため、シートを替える工夫も必要になってくると思います。
ならば、月ごとにシートを加える一つの方法ですが、試してみてください。
累積結果のシート名を累積結果4月、累積結果5月のように月名を加えて、
Dim A As String
Dim B As String
と宣言して、
'=====入力結果保存==========================
Workbooks.Open "C:\累積.xls"
’最後のシートから月名を格納
A = Right(Worksheets(Worksheets.Count).Name, 2)
’本日の月名を格納
B = Month(Now) & "月"
’シートの月名と本日の月名が違っていたら、
If A <> B Then
’シートを追加して、シート名を"累積結果＋本日の月名"とする
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "累積結果" & B
’項目名を１列目に記入
Range("A1").Resize(1, 6).Value = Workbooks("入力.xls") _
.Sheets("入力結果").Range("A1").Resize(1, 6).Value
’データの書き込み
Worksheets(Worksheets.Count).Range("A65536").End(xlUp) _
.Offset(1).PasteSpecial Paste:=xlValues
’月名が同じなら
Else
’最後のシートにデータを追加
Worksheets(Worksheets.Count).Range("A65536").End(xlUp) _
.Offset(1).PasteSpecial Paste:=xlValues
End If
’累積.xlsを上書き保存
Workbooks("累積.xls").Close True
|
|
ponpon
- 05/6/26(日) 17:17 -
