A41枚に10人分の社員証を作成
写真付き
作成したい所属部（データのリストで作成済み）を選択しマクロボタンを押すと、
同ブック内にあるシート「名簿」から氏名・所属、シート「資格」とシート「目標」からぞれぞれ該当の部署に所属する社員の情報が取得され、シート「名札」にデータが貼り付けられるという作り。
社員のデータはシート「名簿」にあり。

以下、作成したものを貼付します

修正およびもっと簡単な方法あれば教えてください
※最初の段階で、所属を選択せずにマクロボタンを押すとエラー！マークで「所属を選択してください」と表示され、何の動作もされないという作りにしたい

Option Explicit

Private Counter As Integer    'データが何件目かを数えるための変数
Private CounterforCard As Integer 'A4用紙1枚内で何番目のカードか
Private OffsetX As Integer
Private OffsetY As Integer



Sub MakeCard()

  Dim i As Long '名簿の行数のカウントアップ用
    Dim j As Long '転記先の行数のカウントアップ用

Dim rw As Long '最終行取得用
Dim shtMeibo As Worksheet
Set shtMeibo = Worksheets("名簿")
Dim nafuda As Worksheet
Set nafuda = Worksheets("名札")

If Range("AM3").Value <> "" Then


 shtMeibo.Activate
 rw = Cells(Rows.Count, 1).End(xlUp).Row
    
    j = 4 '初期設定
    
    For i = 2 To rw
        If Cells(i, 2) = Range("AM3").Value Then
            With nafuda
                .Cells(j, 7) = Cells(i, 8)
                j = j + 13
            End With
        End If
    Next i
    











'A4に１０枚の名札をつくる
Dim MaxRow As Long      'データの最終行取得
MaxRow = shtMeibo.Cells(Rows.Count, 1).End(xlUp).Row

OffsetX = 0
OffsetY = 0
For Counter = 1 To MaxRow - 2
    CounterforCard = Counter Mod 10

   If CounterforCard Mod 2 = 0 Then
      OffsetX = 10
Else
  OffsetX = 0
  If CounterforCard = 1 Then
     OffsetY = 0
  Else
     OffsetY = OffsetY + 13
  End If
End If

'社員各データ取り込む変数

Dim Simei As String              '氏名
Dim Busho As String              '部署
Dim HinsitsuMokuhyou As String  '私の品質目標
Dim KankyouMokuhyou As String    '私の環境目標
Dim Sikaku1 As String       '資格表の左から
Dim Sikaku2 As String
Dim Sikaku3 As String
Dim Sikaku4 As String
Dim Sikaku5 As String
Dim Sikaku6 As String
Dim Sikaku7 As String
Dim Sikaku8 As String
Dim Sikaku9 As String


    'ワークシート名簿をオブジェクト変数に

Dim mokuhyou As Worksheet
Set mokuhyou = Worksheets("目標")
Dim sikaku As Worksheet
Set sikaku = Worksheets("資格")


'リストから変数にデータを格納
Simei = shtMeibo.Cells(1 + Counter, 8).Value              '氏名
Busho = shtMeibo.Cells(1 + Counter, 2).Value            '部署
HinsitsuMokuhyou = mokuhyou.Cells(2 + Counter, 4).Value '私の品質目標
KankyouMokuhyou = mokuhyou.Cells(2 + Counter, 5).Value  '私の環境目標
Sikaku1 = sikaku.Cells(3 + Counter, 4).Value    '資格表の左から
Sikaku2 = sikaku.Cells(3 + Counter, 5).Value
Sikaku3 = sikaku.Cells(3 + Counter, 6).Value
Sikaku4 = sikaku.Cells(3 + Counter, 7).Value
Sikaku5 = sikaku.Cells(3 + Counter, 8).Value
Sikaku6 = sikaku.Cells(3 + Counter, 9).Value
Sikaku7 = sikaku.Cells(3 + Counter, 10).Value
Sikaku8 = sikaku.Cells(3 + Counter, 11).Value
Sikaku9 = sikaku.Cells(3 + Counter, 12).Value


'変数を名札のセルの代入
nafuda.Cells(4 + OffsetY, 7).Value = Simei
nafuda.Cells(4 + OffsetY, 4).Value = Busho
nafuda.Cells(7 + OffsetY, 1).Value = HinsitsuMokuhyou
nafuda.Cells(9 + OffsetY, 1).Value = KankyouMokuhyou
nafuda.Cells(12 + OffsetY, 2).Value = Sikaku1
nafuda.Cells(12 + OffsetY, 3).Value = Sikaku2
nafuda.Cells(12 + OffsetY, 4).Value = Sikaku3
nafuda.Cells(12 + OffsetY, 5).Value = Sikaku4
nafuda.Cells(12 + OffsetY, 7).Value = Sikaku5
nafuda.Cells(12 + OffsetY, 9).Value = Sikaku6
nafuda.Cells(12 + OffsetY, 11).Value = Sikaku7
nafuda.Cells(12 + OffsetY, 14).Value = Sikaku8
nafuda.Cells(4 + OffsetY, 16).Value = Sikaku9



Next Counter

Set shtMeibo = Nothing



Else


MsgBox "印刷したい所属を選択してください。", vbExclamation, "削除の確認"



End If



End Sub

■書きこむ際の注意
>マルチポストはご遠慮ください。
>(同じ内容の質問を、同時に複数の掲示板に投稿 する行為をマルチポストと言います。) 
>詳しくはこちらをご覧になってください。
とされています。