スキルアップ・問題解決なら、モーグにおまかせ！

エクセル2010です
会社で総務に所属し、社員証の発行を頼まれたのですが、200人近くいて、写真も貼らなくてはいけません。
所属部ごと配るそうなので、マクロのボタンで所属を選択すると、その所属の社員の情報がシート「名簿」&シート「資格」&シート「目標」から取得され、シート「名札」に表示されるという仕組みにしたいです。
以下のようなプロシージャを作成しましたが、うまく機能せず。
VBA初心者なので、わかりすくご教示ください。
因みに、A4１枚に10人分の名札が印字されるようにしたいです。
ファイルは1つの中で完結にし、以下にはありませんが、社員と社章も結合セル内に決まった大きさで収まるように設定したいです。
 
 
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
 
 
 

まずは、コードだけ示したデバッグ依頼は感心しません。
焦点を絞って、困っているところ詰まっているところについて、具体的な質問をしてください。
 
また、既存のシートや作成すべきシートのレイアウトをきちんと説明してください。
間違っている可能性が高いコードを読み解けというのはあんまりでしょう。
  
「うまく機能しない」とは、具体的にどんな点ですか？
エラーが発生しているなら、どの行で発生していて、どんなエラーメッセージですか？
想定と異なる結果ということなら、実際と想定を対比して説明してください。
なお、データの提示については、簡略にしたものでも結構です。

Ａ４用紙に１０件（レイアウト不明？）を印刷する
という仕様ですが、
ご存知と思いますが、印刷する際、「余白」を考慮する必要があります。
つまり、Ａ４縦：２９７mmを１０等分した時、１件目と１０件目は「余白」があるため、
２件目〜９件目と同じレイアウトにはなりません。
なお、余白は、プリンタによって異なることがあります。
  
市販のラベル用紙を使うことをお勧めします。
  
私見ですが、このような場合、Ｗｏｒｄの差込印刷を利用すると
ＶＢＡで対応する必要もないと思います。
シート間のデータの編集は、関数で対応できると思うので・・・
 

「うまくいかない」は希望の動作と違う と言うだけで
希望の動作 の内容と、その希望と現実の違い が判った方が 回答しやすいです。
 
何となく、何処のシートのどこのセルからデータを持ってきて
Worksheets("名札") が 印刷をする 名札の シートであると判りますが。
 
 
とりあえず何点か
1：複数のシートから印刷用のデータを持ってきていますが
　そのデータの 並び順（同一氏名者のデータが同じ行にある）の確認は出来ていますか
 
2：複数シートを使っていますが、ワークシートを指定せずに Cells().Value 等の記述がみられます。
　　その時、その指定の仕方では、アクティブシートのセルを指定している事になります。
　　きちんと、ワークシートから指定した方が良いです。
 
3：

    rw = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To rw
      If shtMeibo.Cells(i, 2) = Range("AM3").Value Then
        nafuda.Cells(j, 7) = Cells(i, 8)
        j = j + 13
      End If
    Next i

    'A4に１０枚の名札をつくる
    MaxRow = shtMeibo.Cells(shtMeibo.Rows.Count, 1).End(xlUp).Row
    For Counter = 1 To MaxRow - 2
　　　：
      Simei = shtMeibo.Cells(1 + Counter, 8).Value '氏名

   If CounterforCard Mod 2 = 0 Then
      OffsetX = 10

コードを修正していくことはできるとは思いますが、
実際に社員証発行ということになると、デザイン面もありますし、
普通のプリンターでは対応できないでしょうし、
やはり、一定のコストをかけて外注したほうがよいのではないですか？

コードを読めば、何をしたいかは大体わかる。
 
まず、オフセットで位置を設定していく方法を単純化しよう。
tempというシートを作って、ここに１枚分の名札レイアウトを作る。
必要な要素でtempシートを埋めたら、後は名札シートのコピーを作って、張りたい範囲の左上を指定して貼り付けていけばいい。
（こうすれば、メンテナンスも楽だ。）
絵も貼り付けたいようだけど、これもtempシートにレイアウトすればいい。
コピーの仕方によっては画像も一緒にコピーしてくれる。
 

Sub MakeCard改()
 
    Dim i As Long '名簿の行数のカウントアップ用
    Dim j As Long '転記先の行数のカウントアップ用
 
    Dim rw As Long '最終行取得用
    Dim shtMeibo As Worksheet
    Dim nafuda As Worksheet
    Dim MaxRow As Long 'データの最終行取得
    Dim tempWS As Worksheet     '////　ひな形となるワークシートを追加
    Dim SheetNameCnt As Long
    
    '社員各データ取り込む変数
 
    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
    Dim sikaku As Worksheet
    
    
    Set shtMeibo = Worksheets("名簿")
    'Set nafuda = Worksheets("名札")        '不要
    Set mokuhyou = Worksheets("目標")
    Set sikaku = Worksheets("資格")
    Set tempWS = Worksheets("temp") '////　ひな形となるワークシートを追加
 
    shtMeibo.Activate
    If Range("AM3").Value = "" Then
        MsgBox "印刷したい所属を選択してください。", vbExclamation, "削除の確認"
        Exit Sub
    End If
    
    shtMeibo.Activate
    rw = Cells(Rows.Count, 1).End(xlUp).Row

    'A4に１０枚の名札をつくる
    MaxRow = shtMeibo.Cells(Rows.Count, 1).End(xlUp).Row
    
    SheetNameCnt = 1
    For Counter = 1 To MaxRow - 2           '名簿のループ
        CounterforCard = Counter Mod 10     'CounterforCard=1,2,3,4,5,6,7,8,9,0,1,2,3...

        If CounterforCard = 1 Then
            Worksheets("名札").Copy After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = "名札" & SheetNameCnt
            Set nafuda = ActiveSheet
            SheetNameCnt = SheetNameCnt + 1
        End If

        'ひな形を初期化
        tempWS.Range("G1") = ""
        tempWS.Range("D1") = ""
        tempWS.Range("A4") = ""
        tempWS.Range("A6") = ""
        tempWS.Range("B9") = ""
        tempWS.Range("C9") = ""
        tempWS.Range("D9") = ""
        tempWS.Range("E9") = ""
        tempWS.Range("G9") = ""
        tempWS.Range("I9") = ""
        tempWS.Range("K9") = ""
        tempWS.Range("N9") = ""
        tempWS.Range("P1") = ""

        'リストから変数にデータを格納
        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
        
        'ひな形に入力
        tempWS.Range("G1") = Simei
        tempWS.Range("D1") = Busho
        tempWS.Range("A4") = HinsitsuMokuhyou
        tempWS.Range("A6") = KankyouMokuhyou
        tempWS.Range("B9") = Sikaku1
        tempWS.Range("C9") = Sikaku2
        tempWS.Range("D9") = Sikaku3
        tempWS.Range("E9") = Sikaku4
        tempWS.Range("G9") = Sikaku5
        tempWS.Range("I9") = Sikaku6
        tempWS.Range("K9") = Sikaku7
        tempWS.Range("N9") = Sikaku8
        tempWS.Range("P1") = Sikaku9
        
        '貼り付けは１０個なのでべた書き
        Select Case CounterforCard
            Case 1
                tempWS.Range("A1:P9").Copy nafuda.Range("A4")
            Case 2
            
                'このコピー＆貼り付けだと画像はコピーしない。
                'tempWS.Range("A1:P9").Copy
                'nafuda.Range("A17").PasteSpecial xlPasteAll
                'だから以下を使う
                
                tempWS.Range("A1:P9").Copy nafuda.Range("A17")
            
            Case 3
                tempWS.Range("A1:P9").Copy nafuda.Range("A30")
            Case 4
                tempWS.Range("A1:P9").Copy nafuda.Range("A43")
            Case 5
                tempWS.Range("A1:P9").Copy nafuda.Range("A56")
            Case 6
                tempWS.Range("A1:P9").Copy nafuda.Range("Q4")
            Case 7
                tempWS.Range("A1:P9").Copy nafuda.Range("Q17")
            Case 8
                tempWS.Range("A1:P9").Copy nafuda.Range("Q30")
            Case 9
                tempWS.Range("A1:P9").Copy nafuda.Range("Q43")
            Case 0
                tempWS.Range("A1:P9").Copy nafuda.Range("Q56")
            Case Else
            
        End Select

    Next Counter

    Set shtMeibo = Nothing
 
End Sub

ほぼ同様の仕様の自動転記・印刷のマクロを過去開発した経験がありますが、
セルの幅に収まらない文字数の時の処理にご注意ください。
 
単にセル幅に収まるようにテキストを自動で拡縮するだけではダメなケースもあります。
名前はよっぽどセル幅に収まると思いますが、目標シートの値というのが超過するんじゃないかと思いました。
 
私がマクロで組んだシステムでは印刷フォーマットのシートの背景に画像を挿入し、
その画像＝A4印刷（余白処理に合わせて多少小さいサイズ）用の範囲になっております。
 
画像には印刷レイアウトの枠や事前に印刷を確定させておきたい固定資料（今回の場合は社章等）を掲載しておき、可能な限り動的な画像の挿入枚数を減らしてました。
 
画像を取り込むそうなので取り込むサイズの画像は全て同じサイズの縦横比になっていればセルの左上・右下の始点終点座標がわかれば自動でサイズ調整して貼れると思うので難しくないと思います。
 
先の方々が言及している通り、どこがうまくいかないのかわかりませんが必要なら参考にして下さい。
（PrintOutメソッドに言及が無いので多分正常に出ているかもしれませんが）

＞200人近くいて、写真も貼らなくてはいけません。
 
200人くらいなら、手動でやった方が、わけのわからないマクロをいじり倒すより
終わりが早いかと。
 
今のやりかただと、写真一つ一つにそれぞれの名前と紐づけする必要があります。
今後も度々いろいろな場面で再利用されるなら別ですが、
二度手間な気がしないでもないです。
 
あと、ざっと流し読みしかしてないですが、
各シートにバラバラにデータがあるんですかね？
まずは、一覧表を作るところ（写真ファイルのフルパスを含む）から始めてみては？
なんて考えてると、一覧表に入力するアプリから作りたくなったり。。。。＾＾；
 
マクロを作ると一瞬でできる気がしますが、
一瞬でできるようになるまでに、なかなかの時間が必要になりますので、
ご覚悟を。

回答者の皆さんから質問や提案が出されていますが、反応いただきたいですね。
また、少なくとも質問には答えてもらわないと、前に進みませんよ。
 
1.（指摘が既にありますが）名簿、目標、資格の各シートで
   同一者は同一の行にあるのですか？
   そうでなければ、氏名コードなどをキーにしてVLOOKUP等で対応づける必要があります。
 
2. 部署別に実行するんですよね。
   質問にあるコードでは、最初に部署でチェックして氏名だけを転記していますが、
   そのあとの処理ではまったく部署は顧みられておらず、しかも上の処理に
   上書きされています。部署で限定する必要があるでしょう。
    
   全部署対象の名簿のループカウンターと、
   特定部署の印刷対象のカウンターを使い分ける必要があります。
 
3. A4に10枚の社員証を入れる予定だそうですが、そのレイアウトをきちんと考えて提示してください。
   横に２，縦に５個の社員証を作成するのですか？
   これも質問にあるコードでは、OffsetX＝10　が使われていますが、
   これは左のブロックが10列、右のブロックも10列ということですよね。
   しかし、左側のブロックで、11,14,16列目に書き込んでいます。
   これだと重なってしまうじゃないですか。
   項目位置を変えるか、OffsetX＝10をOffset=16 にするとかが必要でしょう。
    
   項目に入る文字数などを考慮して、項目位置を確定してください。
 
全般に、何か既存のコードに中途半端に手を加えた印象を受けます。
仕様をきちんと反映していく必要があります。

私も
> 横に２，縦に５個の社員証を作成する
と思いたいが、
>'変数を名札のセルの代入
のコードの中では、
OffsetXが使われていないように見えるが、
見落としがあるのでしょうか？
 

その件は、Suzuさんが 投稿日時: 22/03/14 09:34:20の
4.項で既に指摘されています。
縦10でも２×５でも可能は可能ですが、コードと不整合になっているということです。
縦に10個並べるなら、偶奇判定は必要ありませんね。

Q＆A 掲示板ご利用上のお願い
https://www.moug.net/faq/kiyaku.html
の中の禁止事項に
> コード制作依頼
> 「●●●を実行するようなマクロを作りたいのですが」「●●●をする方法を教えてください」
> といった、コード制作依頼ともとれるような質問はおやめください。
とあります。
 
http://windowstip.web.fc2.com/vbatips/tips/card-sakusei1.html
からの４頁にわたる記事に少し手を入れただけですよね。
社印だとか社章だとか写真なども要望されているようですが、
こちらからの確認にも回答はなく、要するに作成依頼のように私には見えます。
私はここまでとします。
 
なお、親切な方がご要望に応えてくださるかもしれません。
それはそれで結構なことかもしれません。