はじめに
本記事はこの記事の続編です。
よろしければこちらもお読みください。
今回の目標
前回の記事でシート名に氏名を記入したシートの作成まで行ったので、今回は各シートに基本データから成績を転記する処理をしていきます。
今回は各ページのレイアウトをこんな感じにしたいと思います。
コードの記述
以下のような処理を書きます。
各シートへの転記
Sub copy_and_paste()
Dim i As Integer
For i = 2 To Sheets.Count
'カラーコードでセルの色を指定
Sheets(i).Range("A1:B1").Interior.ColorIndex = 36
Sheets(i).Range("C1:G1").Interior.ColorIndex = 20
'基本データの情報をコピーして各シートに貼り付け
Sheets(i).Range("A1:G1").Value = Sheets("基本データ").Range("A1:G1").Value
Sheets(i).Range("A2:G2").Value = Sheets("基本データ").Range(Cells(i, "A"), Cells(i, "G")).Value
Next i
End Sub
実行結果
今回は「データ転記」という名前の実行ボタンを作成しました。
前回取り組んだ「シート作成」から通しで実行してみます。
うまくシートを作成することができました。
おまけ
おまけとして今回作成した大量のシートを一気に削除する処理を示しておきたいと思います。
以下のコードで「基本データ」以外のシートを削除できます。
シートの削除
Sub delete_sheets()
Dim ws As Worksheet
'シート削除の確認ポップアップを非表示
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "基本データ"
Case Else
ws.Delete
End Select
Next ws
Worksheets("基本データ").Activate
End Sub
一瞬で削除することができました。
まとめ
前回と今回を通して実務で使いそうな？処理の自動化を実現することができました。
今後もネタが思いつき次第記事にしていきたいと思います。
何かあればコメントお願いします。