エクセル2003にて指定されたシートを複写するには？

質問

エクセル2003にて指定されたシートを複写するには？

はじめて投稿します。過去ログを調べたのですが、該当する質問を
発見することが出来なったので、宜しくお願い致します。

【質問内容】
エクセル2003にて、「シート１」は、以下のようになっています。
　　A　　B　　　C
1　10　りんご　秋田
2　20　みかん　青森
3　30　バナナ　岩手
4　40　キウイ　島根
5　50　イチゴ　鳥取

マクロ（VBA？）で実施したいのは、「10」「20」・・・と
いった文字列を「シート名」として、「シート２」に保存されている
レイアウトをコピーし、「10」「20」とシート名として、コピーし、
反映させた上で、「シート１」のA1である『10』を新しくコピーされた
シートである「10」のA列の5行目に「10」を持ってきたいと思っています。
（※B列以降は、VLOOKUPで持ってこようと思っています。）

800シート近くになり、毎週の処理な上、ひとつひとつやるには、時間ばっかり
必要になるので、マクロ（VBA?）で解決したいと思っております。
（※例のように５シート分であれば、手でやるのですが、、、）

すみませんが、ご享受の程、宜しくお願い申し上げます。

回答No.2

soixante · ベストアンサー

＃1です。
とりあえず、シート２のレイアウトは無視した形ですが以下です。

Sub aaa()

Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Worksheets("シート１")
Set Ws2 = Worksheets("シート２")

Dim Endrow As Long, r As Integer
Endrow = Ws1.Cells(Rows.Count, 1).End(xlUp).Row

For r = 1 To Endrow
　　　 Worksheets.Add After:=Worksheets(Worksheets.Count)
　　　ActiveSheet.Name = Ws1.Cells(r, 1).Value
　　　Cells(5, 1).Value = Ws1.Cells(r, 1).Value
　　　Cells(5, 2).Value = Ws1.Cells(r, 2).Value
　　　Cells(5, 3).Value = Ws1.Cells(r, 3).Value
Next r

Set Ws1 = Nothing
Set Ws2 = Nothing
End Sub

B列以降も一緒に移してしまいました。適当にアレンジください。

お礼

ご丁寧にありがとうございます。

会社のＰＣでしか検証が出来ませんが、
ご意見をもとに頑張ってみようと思います。

本当にありがとうございます。

回答No.1

soixante

ちょっと分かりにくいですね。
もうちょっと補足情報が必要です。

・シート1には、1行目から800行目までデータがあるのですか？
・「10」「20」から「8000」まで、800枚のシートを作成するのですか。
・シート２のレイアウトというのは、どういうものなのですか。

条件がしっかり分かれば解決の糸口になるかもしれません。

補足

すみません、回答が遅くなりました、、、
ありがとうございます。

＞・シート1には、1行目から800行目までデータがあるのですか？

そのとおりです。800行は最大ですが、400～800行までデータがあると
考えて頂ければ幸いです。

＞・「10」「20」から「8000」まで、800枚のシートを作成するのですか。

メモリの問題等で難しいとは思いますが、
言われているとおり、800枚のシートを作りたいと思っています。

＞・シート２のレイアウトというのは、どういうものなのですか。

シート２のレイアウトは、わかりづらいですね、、、すみません。
簡単に説明すると書式（文字の大きさ・書体）を設定されている
もので、様式といった方がよかったかもしれないですね。

ご丁寧にありがとうございます。