【エクセル】新規シートを作成しながら代入

質問

エクセルで複数の見積書を一気に作りたいです。

見積書のフォーマットは同じで、
「社名」の部分と「金額」の部分のみを差し替えたものを、
たくさん作成したいです。

Sheet1に、

社名１　50000
社名２　20000
社名３　68000　…

のように、作成したい見積書の社名と金額のリストをおくと、
１）Sheet１リストの社名の数だけ見積書シートを作成し、
２）任意の場所に社名と金額を代入して、
リストの項目の数だけ見積書を作成するような関数やマクロは書けないでしょうか。

つまり、
Sheet1!A1 -> Sheet2!C1, Sheet1!B1 -> Sheet2!C2
Sheet1!A2 -> Sheet3!C1, Sheet1!B2 -> Sheet3!C2
Sheet2!A3 -> Sheet4!C1, Sheet1!B3 -> Sheet4!C2
といった具合で引用したいです。

Sheet１のリスト項目数は不定です。

（当方VBAの知識ありません。）

どうぞ宜しくお願い致します。

回答No.2

web2525 · ベストアンサー

Sub Macro1()
社名 = Sheets(1).Range("A1")
金額 = Sheets(1).Range("B1")
no = Sheets.Count
i = 0
Do Until 社名 = ""
i = i + 1
Sheets(2).Copy after:=Sheets(no)
no = no + 1
Sheets(no).Name = "見積書（" & 社名 & ")"
Range("C2").Value = 社名
Range("C3").Value = 金額
社名 = Sheets(1).Range("A1").Offset(i, 0)
金額 = Sheets(1).Range("B1").Offset(i, 0)
Loop

End Sub

Sheet1に会社名・金額の一覧、Sheet2に見積書原本ある状態で。

＞当方VBAの知識ありません。

VBAは環境（Sheetのフォーマット等）により細かな修正が必要になります。
VBAの知識がまったく無い状態だと回答が得られたとしてもその修正が出来ないため、希望通りの動作となる可能性は少ないのです。

お礼

皆様の分を参考に試行錯誤の結果、思い通りのものがかけました。
これを機にVBAを勉強しようと思いました。
ありがとうございました！！

回答No.5

hige_082

お初です
まずは、禁止事項の丸投げの項目をお読みください
＞マクロは書けないでしょうか。
＞（当方VBAの知識ありません。）
ここでコードを提示しても、使いこなせるか疑問です

上記の理由から関数にします
見積書のフォーマットの一番上に１行挿入する
印刷範囲をＡ２からに変更しておく
見積書のフォーマットのＣ１へ
=VLOOKUP(A1,Sheet1!A1:B20,1,FALSE )
見積書のフォーマットのＣ２へ
=VLOOKUP(A1,Sheet1!A1:B20,2,FALSE )
と、しておいて
見積書のフォーマットのＡ１に会社名を入力
見積書のフォーマットのそれぞれに社名と金額が入ります
見積書のフォーマットのＡ１に入力規則のリストを設定すれば
社名をリストから選択するだけ

メリットは質問の方法だと、シートタブから社名がわからない
シートが増えると、タブが隠れて探すのがさらに困難

社名のリストに名前を定義設定すれば、社名の増減があっつた場合に
定義設定を変更すれば、数式の範囲やリストの設定を変更をしなくてよくなるので
さらに使いやすくなると思います

以上　参考までに

お礼

皆様の分を参考に試行錯誤の結果、思い通りのものがかけました。
これを機にVBAを勉強しようと思いました。
ありがとうございました！！

回答No.4

noah7150

ちなみに標準のままだとSheet3があるのでSheet3の削除を若しくはシート名を変更して置かないとエラーになりますよ

お礼

皆様の分を参考に試行錯誤の結果、思い通りのものがかけました。
これを機にVBAを勉強しようと思いました。
ありがとうございました！！

回答No.3

noah7150

A1形式が分かりやすいならCellsではなくてRangeを使うほうが分かりやすかったかな

Sub Macro1()
Dim Row As Long '行繰り返し用

Row = 1 '1行目から繰り返すため初期設定

While Sheets("Sheet2").Range("A" + CStr(Row)) <> "" 'Sheet2の該当行、１セル目が空欄でないなら繰り返す
Sheets("Sheet1").Copy After:=Sheets(Sheets.Count) 'Sheet1を最終位置に複写して新たなシートを追加
ActiveSheet.Name = "Sheet" + CStr(Sheets.Count) '追加したシートの名前を変更
ActiveSheet.Range("A" + CStr(Row)).Formula = "=Sheet2!A" + CStr(Row) '追加したシートのA列 文字列に変換したRow行に計算式をセット
Row = Row + 1
Wend 'ここまでを繰り返す
End Sub

お礼

皆様の分を参考に試行錯誤の結果、思い通りのものがかけました。
これを機にVBAを勉強しようと思いました。
ありがとうございました！！

回答No.1

noah7150

基本的に丸投げは禁止なのですが

Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2009/1/6 ユーザー名 :
'

Dim Row As Long '行繰り返し用

Row = 1 '1行目から繰り返すため初期設定

While Sheets("Sheet2").Cells(Row, 1) <> "" 'Sheet2の該当行、１セル目が空欄でないなら繰り返す
Sheets("Sheet1").Copy After:=Sheets(Sheets.Count) 'Sheet1を最終位置に複写して新たなシートを追加
ActiveSheet.Name = "Sheet" + CStr(Sheets.Count) '追加したシートの名前を変更
ActiveSheet.Cells(1, 1).Formula = "=Sheet2!A" + CStr(Row) '追加したシートの1行目、1列目に計算式をセット
Row = Row + 1
Wend 'ここまでを繰り返す
End Sub

以上
Sheet1が見積もり雛形、Sheet2が社名一覧として書いてあります
複数の計算式があるなら
ActiveSheet.Cells(1, 1).Formula = "=Sheet2!A" + CStr(Row) '追加したシートの1行目、1列目に計算式をセット
をCells(1, 1)をCells(1, 3)、"=Sheet2!C"などに変えて追加してね
尚、Cells(行,欄)ですC2だとCells(2,3)と前後が逆になります。

お礼

皆様の分を参考に試行錯誤の結果、思い通りのものがかけました。
これを機にVBAを勉強しようと思いました。
ありがとうございました！！