| 
    
     |  | ▼マナ さん: ありがとうございました。
 前述の修正と以下に頂いたものを確認しながら、勉強してみます。
 品名の後ろの年月、すっかり忘れてました笑
 これ重要だったのに。
 ソートの部分も、ごちゃごちゃ書かずにすっきりできたので、
 変数の部分と合わせて確認しながら書いてみます。
 
 >▼ありす さん:
 >
 >こんな書き方もできます
 >マクロで、Noを作成し、最後に削除しています。
 >
 >>・最後に並べ替えをする際に、コードが被る事があるので、C列に並べ替え用Noを入れる項目を追加。
 >
 
 >
 >Option Explicit
 >
 >Sub test()
 >  Dim wsF As Worksheet, wsT As Worksheet
 >  Dim 期間 As Long, 開始日 As Date
 >  Dim 元データ As Range, データ数 As Long
 >  Dim 貼付先 As Range
 >  Dim k As Long, 月末 As Date
 >  Dim 商品名 As Range, 数式 As String
 >  Dim ソート範囲 As Range
 >
 >  Set wsF = Worksheets("Sheet1")
 >  Set wsT = Worksheets("Sheet2") '転記先
 >
 >  期間 = wsF.Range("B5").Value
 >  開始日 = wsF.Range("B6").Value
 >
 >  Set 元データ = wsF.Range("C6", wsF.Range("K" & Rows.Count).End(xlUp))
 >  元データ.Columns(1).Formula = "=row()"  '並べ替え用No
 >  データ数 = 元データ.Rows.Count
 >
 >  Set 貼付先 = wsT.Range("C6")
 >
 >  For k = 1 To 期間
 >'  'sheet1のデータをsheet2に貼り付け
 >    元データ.Copy
 >    貼付先.PasteSpecial xlPasteValues
 >
 >    '日付の入力
 >    月末 = DateSerial(Year(開始日), Month(開始日) + k, 0)
 >    貼付先.Resize(データ数).Columns(2).Value = 月末
 >
 >    '商品名に日付を付加
 >    Set 商品名 = 貼付先.Resize(データ数).Columns(7)
 >    数式 = 商品名.Address & "&""" & Format(月末, "('yy/m月分)") & """"
 >    商品名.Value = 商品名.Worksheet.Evaluate(数式)
 >
 >    Set 貼付先 = 貼付先.Offset(データ数)
 >  Next
 >
 >  '並べ替え
 >  Set ソート範囲 = wsT.Range("C6", wsT.Range("K" & Rows.Count).End(xlUp))
 >  ソート範囲.Sort ソート範囲.Columns(1)
 >
 >  '並べ替え用Noの削除
 >  ソート範囲.Columns(1).ClearContents
 >  元データ.Columns(1).ClearContents
 >
 >End Sub
 >
 >
 >
 
 |  |