エクセルVBAについて

質問

＜sheet1＞フォーマット（コピーするシート）
＜sheet2＞　　　
A列　　　　B列
○○支店　　15
△△支店　　10
××支店　　28
■■支店　　25
◎◎支店　　18

sheet1のフォーマットをsheet2のB列の数コピーして、sheet2のA列の支店別に新しいブックへ保存するという作業のマクロを組みたいのですがどのようにしたらよいでしょうか？お教えください。VBAに関しまして初心者で、勉強しているのですがいまいちわかりません。どうぞよろしくお願いします。

今、一つだけコピーして保存するということはできていますが、上記のように全部を自動的にしたいのですが・・・

Sub グラフをコピーして別ブックへ保存()
Dim mySheet As Worksheet
Set mySheet = ActiveWorkbook.Worksheets("グラフ")
mySheet.Copy
ActiveWorkbook.SaveAs Filename:="大阪第一" '別名を付けてブックを保存する
ActiveWorkbook.Close '別名ブックを閉じる
End Sub

よろしくお願いします。

回答No.4

takibo · ベストアンサー

No.1です。
全く同じコードで動作確認してますのでこちらで原因の判断は難しいですね…
以下のことを試してみて何か変わるといいのですが。
・コードの1行目（Application Screen～）部分を消して画面の動きを見てみる
・一覧表（sheet2）を並べ替えてみる、または入力しなおしてみる

他サイトの方で良い回答が得られているといいですね。
お力になれなくてすみません。

お礼

お返事遅くなりました。すいません。
原因は、ＶＢＡのプロジェクトのところにコピーしたsheetの履歴が残るせいか？！よくわからないです。
最大８５sheetぐらいなのですかね？何故かはわからないです。ありがとうございました。
コピーしたsheetをブックに保存ではなく、新しいブックにsheetをコピーしていき最後に保存するというふうに順序を入れ替えればとアドバイスをいただきました。
でも、まだ保留中です。また何かありましたら宜しくお願いします。

回答No.3

zurumukeZ

エクセルVBAのことはここのほうが詳しく教えてくれます。
http://park7.wakwak.com/~efc21/cgi-bin/wwwlng.cgi

回答No.2

takibo

No.1です。
実際見ていないので定かではありませんが、シート名が違うのではないでしょうか？（半角/全角など）
先程のコードは全角です。

シートの名前に左右されないようにするには
Sheets("グラフ").Copy after:=Worksheets(Worksheets.Count)
の部分を
Sheets(1).Copy after:=Worksheets(Worksheets.Count)
としてください。
カッコ内の数字はシートのインデックスで、画面上左から何番目のシートか、ということをあらわします。
通常 sheet1＝sheets(1)となります。

お礼

度々ありがとうございます。
シート名は正しいとおもうのですが・・・！？
保存するブックは１２支店分あり、５支店目でシートコピー”グラフ-11”で止まってしまいます。
４支店分は保存され大丈夫なので、急に５支店目で止まるのがわかりません。
毎回同じところなので５支店目のところの”グラフ-12”からおかしいのでしょうね？
どうなんでしょうか？本当に申し訳ございません。

回答No.1

takibo

Sub グラフをコピーして別ブックへ保存()
Dim MyS() As String

Application.ScreenUpdating = False
パス = ThisWorkbook.Path '←←←作業中のBookの保存先を取得
i = 1 '←←←sheet2の1行目から…
Do While Worksheets(2).Cells(i, 1) <> "" '←←←空白でデータ終了
支店 = Worksheets(2).Cells(i, 1).Value
枚数 = Worksheets(2).Cells(i, 2).Value
For c = 1 To 枚数
Sheets("グラフ").Copy after:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = "グラフ-" & c
Next
ReDim MyS(1 To 枚数)
For m = 1 To 枚数
MyS(m) = "グラフ-" & m
Next
Sheets(MyS).Move
ActiveWorkbook.SaveAs Filename:=パス & "\" & 支店
ActiveWorkbook.Close
i = i + 1
Loop
MsgBox "処理終了"
End Sub

・sheet2の1行目から一覧データがあり、空白でデータ終了とする（A列：保存するファイル名、B列：コピーする枚数）
・[グラフ]というシートをコピーし、[グラフ-1][グラフ-2]…と名前をつける
・作業中のBookと同じ場所に保存する（念のため）
上記の条件の下で動くように作ってみました。
作業中Bookに必要枚数だけコピーしてから別Bookに移動して保存、という方法をとっています。

お礼

ありがとうございます。試してみました。
途中に”実行時エラー1004”
worksheetクラスのCopyメソッドが失敗しました。
という表示がでて、進まなくなります。

Sheets("グラフ").Copy after:=Worksheets(Worksheets.Count)
この部分がデバック必要みたいな感じです？！
同じこと繰り返しなのですが、何故でしょうか？
何度もすいません。