dポイントプレゼントキャンペーン実施中!

sb-yamatoと申します。よろしくお願いします。
ボランティア団体の登録者管理をしておりまして、エクセルVBAで人数分のシートを作成しながら差し込みができないかと悩んでいます。
イメージとしては、ワードの差し込み印刷をすると、人数分のページができると思います。それをエクセルシートでできないでしょうか?

自分なりに作ってはみたのですが、変数iの使い方が悪いのか、どうも上手くいきません。こんな感じです。
Sub シートの作成()
Dim touroku As Long ←登録番号です。(8桁)
Dim simei As String ←漢字氏名です。
Dim seinen As Date  ←生年月日です。
Dim i As Byte    ←150人までです。
i = 2        ←1行目はタイトル行です。
Worksheets("名簿").Activate
Do While Cells(i, "B").Value <> ""
touroku = Range(i, "B").Value
simei = Range(i, "C").Value
seinen = Range(i, "D").Value
Worksheets("登録台帳(原本)").Copy After:=Worksheets(i)
Range("AI2").Value = touroku
Range("AJ2").Value = simei
Range("AK2").Value = seinen
ActiveSheets.Name = Range("AJ2").Value
i = i + 1
Loop
End Sub

名簿sheetのB列[変数i]行目をコピーしたsheetのセルAI2に貼り付けているつもりなのですが、反応してくれません。
皆様のお力添え、よろしくお願いいたします。

A 回答 (2件)

もう#1で解決したようだが、参考までに、VBA初心者用に


関数を出来るだけ使い、VBAは最小限と言う方法を紹介します。
ーー
Googleで「imogasi 請求書」でWEB照会してみてください。
http://oshiete1.goo.ne.jp/qa3538263.html
ほかたくさん出ます。
ーー
要点はデータのあるシートの空き列に連続番号を(手作業でよい)を
振る。
差込印刷をするシート側で、帳票見出し・項目見出し。罫線、書式の
設定は、合計の算出などはSheet2に対し、手作業でやる。そしてSheet2の空きセルに番号指定セル(Sheet1の現データの行を指定する)を設ける。
そして都度変わるデータは、INDIRECT関数で設定する。
例で説明すると
Sheet1で
A列  B列
氏名 住所 <-第1行目
大村 大田区 <-第2行目
戸塚 調布市 <-第3行目
・・・
Sheet2(印刷するシート)
A1に行番号指定セルを設ける(第1行目は印刷時には、印刷範囲には入れないようにする)
Sheet2の氏名を表示するセルには
=INDIRECT("sheet1!A"&A1)
を入れておく。
Sheet2のA1に2(Sheet1の2行目の人の意味)が入っていると
氏名は「大村」になります。A1に3と入れると氏名は「戸塚」に変わります。
この理屈を住所欄など他の印刷項目にも使います
ーー
その後VBAではSheet2のA1の値を2から最終行まで順次プログラムで自動で変化させ
For i=2 to 23
worksheets("heet2").range("A1")=i
'--Range指定と印刷のコードPrintOutを入れる。1行。
Next i
のたった4行で、質問者の20行程度のコード以上の威力を発揮します。
最終行を捉えるコードが必要だが、簡単。
メリットは
関数に詳しい方には、シートを見て、何をやっているか安心感が有ると思う
(上記で、質問者のコード「以上」といった意味は下記2点)
少しコードの工夫すれば、特定の1人、2人など指定して、臨時にSheet2を印刷できる
Sheet2のレイアウトの修正にもVBAコードは一切触らなくて良い。
    • good
    • 0

SheetをCopyするとActiveSheetが移動するのでSheet名を明示する必要があります。


Worksheets("名簿")はActivateしなくても大丈夫です。
Range(i, "B").Value といった書き方は出来ないです。
やるなら、Range("B" & i).Value です。
Copyで追加されたSheetがActiveSheetになります。
ActiveSheetのNameは変数simeiを使えばよいですね。

Sub testシートの作成()
  Dim touroku As Long '←登録番号です。(8桁)
  Dim simei As String '←漢字氏名です。
  Dim seinen As Date '←生年月日です。
  Dim i As Byte    '←150人までです。
  i = 2        '←1行目はタイトル行です。
  'Worksheets("名簿").Activate
  With Worksheets("名簿")
    Do While .Cells(i, "B").Value <> ""
      touroku = .Cells(i, "B").Value
      simei = .Cells(i, "C").Value
      seinen = .Cells(i, "D").Value
      Worksheets("登録台帳(原本)").Copy After:=Worksheets(i)
      With ActiveSheet
        .Range("AI2").Value = touroku
        .Range("AJ2").Value = simei
        .Range("AK2").Value = seinen
        '.Name = Range("AJ2").Value
        .Name = simei
      End With
      i = i + 1
    Loop
  End With
End Sub
    • good
    • 0
この回答へのお礼

早速のお返事ありがとうございました。
おかげ様で思い通りに動くようになりました。
ありがとうございました。

お礼日時:2009/05/05 20:25

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!