条件を満たしたデータを転記するマクロを作成したいです。 列の並び順が変わってしまうところがネックとなっております。 私が思いつくのが、繰り返しの処理を何回も行なう事なのですが、 もっと簡単に処理を行なう方法がございましたらご教示いただけますと幸いです。 【やりたいこと】 以下の3つの条件で帳票シートへ転記したいです。 ※いずれも列の並びは違います。 〇国・英・数で250点以上 〇家・技・保で250点以上 〇全教科で合計が400点以上 ①タイトルを付ける ②タイトル行を入力する ②テストシートから条件を満たすデータを列の並び順を変えて帳票シートへ転記する ③タイトル以外に罫線を付ける 2行開けて、①と同様の事を繰り返す Sub TEST() '国・英・数で250点以上のデータを転記する Set ws1 = Worksheets("テスト") Set ws2 = Worksheets("帳票") ws2.Cells.Clear Lrow = ws1.Range("B4").End(xlDown).Row ws2.Select ws2.Cells(3, 2) = "国・英・数で250点以上" ws2.Cells(4, 2) = "年度" ws2.Cells(4, 3) = "生徒名" ws2.Cells(4, 4) = "国語" ws2.Cells(4, 5) = "英語" ws2.Cells(4, 6) = "数学" ws2.Cells(4, 7) = "3教科 合計" i = 4 j = 5 For i = 4 To Lrow If ws1.Cells(i, 10) >= 250 Then ws2.Cells(j, 2) = ws1.Cells(i, 2) ws2.Cells(j, 3) = ws1.Cells(i, 4) ws2.Cells(j, 4) = ws1.Cells(i, 3) ws2.Cells(j, 5) = ws1.Cells(i, 5) ws2.Cells(j, 6) = ws1.Cells(i, 9) ws2.Cells(j, 7) = ws1.Cells(i, 10) j = j + 1 End If Next i Range(Cells(4, 2), Cells(j - 1, 7)).Select Selection.Borders.LineStyle = xlContinuous End Sub
Excel