Excel2010 複数シートコピーのマクロエラー

初めて投稿します。

職場でExcel 2000 から Excel 2010へ切り替えがあり
今まで問題なく利用していたマクロがエラーになってしまいました。

　修正をして使用したいのですが
　マクロ初心者で色々とネットで検索して
　ヒントを探ってみたものの
　検索の方法がいけないようで、修正方法が見つけられない状態です。


　　　ファイル内にいくつかのシートがあるのですが
　　　シート名に「A」と付くシート数がその都度異なります。
　　　そのシート「*A」とその他のシートをコピーして
　　　新しいファイルとして保存したいのですが

　　　コピーする段階で

　　　　【実行時エラー '-2147417848(80010108）’
　　　　　Copyメゾットは失敗しました；sheetsオブジェクト】
　　　
　　　　というエラーになってしまいます。　　　　　

　どのように修正すればよいか
　教えていただけないでしょうか。



Sub Macro3()

Dim SH As Worksheet
Dim strString As String
Dim sSH1(10) As String
Dim sSH2(30) As String
Dim i As Integer


Worksheets("開始").Activate


　 sSH1(1) = "あ"
　 sSH1(2) = "い"
　sSH1(3) = "う"
　sSH1(4) = "え"
　sSH1(5) = "お"

　IngCnt = 1

　For Each SH In Worksheets

　 If SH.Name Like "*A*" Then

　 sSH2(IngCnt) = SH.Name
　IngCnt = IngCnt + 1

　 End If

　Next


　If IngCnt = 1 Then

strString = sSH1(1)

　 Else

strString = sSH2(IngCnt - 1)

　End If


　For i = IngCnt To 30

sSH2(i) = strString

　Next i

　'↓ここでエラーになります

Sheets(Array(sSH1(2), sSH1(3), sSH1(4), sSH1(5), sSH2(1), sSH2(2), sSH2(3), sSH2(4), _
　　 sSH2(5), sSH2(6), sSH2(7), sSH2(8),sSH2(9), sSH2(10), sSH2(11), sSH2(12), _
　　 sSH2(13), sSH2(14), sSH2(15), sSH2(16), sSH2(17), sSH2(18), sSH2(19), sSH2(20), _
　　sSH2(21), sSH2(22), sSH2(23), sSH2(24), sSH2(25), sSH2(26), sSH2(27), sSH2(28), _
　　sSH2(29), sSH2(30))).Copy


ActiveWorkbook.SaveAs Filename:="C:\Users\monkey-cr\Desktop\こぴ３.xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

End Sub

というマクロです。
自宅でも同じようにやってみたのですが
やはりエラーになります。
ただコピーするシート数を減らすと問題なく動くので
エラーメッセージの言うようにシート（数）に問題があるという事までは
分かったのですが
「では、どうする？」というのが…。
勉強不足ですいません。

No.2 ベストアンサー 回答者： cj_mover 回答日時： 2013/04/27 19:26

こんにちは。

まず、
> 今まで問題なく利用していたマクロがエラーになってしまいました。
今までは問題が顕在化しなかった、といった方が近いです。
ExcelやVBAのバージョンの問題とは言い切れません。
問題点は、
　　Sheets(Array(arg1, arg2, ...))
Sheetオブジェクトコレクションの指定方法。
言い換えれば、配列変数の基本的な扱い方。
ご提示のコードについて、Array関数の中身について注目すると、
　　"*A*" でヒットするシートの数が
　　　　３０　ならば、問題なく動作
　　　　０　ならば、"あ" を３０回重複指定
　　　　１以上３０未満　ならば
　　　　　　　"*A*" で最後にヒットしたシート名を
　　　　　　　３０－ヒット数分＋１回重複指定
　　　　３０　を超えれば配列に格納する時点で実行時エラー
つまりは、正しい扱い方ができているのは
　　"*A*" でヒットするシートの数が　３０
だった場合だけです。
重複を含む文字列配列をSheetsコレクションのアイテムとして指定するのは
正しい使い方ではありません。
結果的に重複を削除した形で、５～３３点のシートをコピーした
ことになっているように見えて、重複分をコピーするコマンドはタスクとして
残ってしまい、Excelを再起動するまでは解放されないゾンビがメモリを占拠
し続けているようで、危ういです。
このゾンビ、私も理屈はよくわかりませんが、
想像するに循環参照の扱いに似たようなもので、
ネストレベルの低いXL2000では（OSやPCスペックを含めた環境因によって）
たまたま、問題が顕在化しなかった、ということなのではないでしょうか。
（大胆な推論、ですけどね。）

第一のポイントとしては、
過不足なく普通に指定すること、です。

或いはひょっとして、コピー後のシート数を固定にしたくて、
"*A*" でヒットするシートの数が不足する場合に
特定のシートのコピーを不足分だけ作成したい
というニーズなのかな？
と、コードの作りだけを読むと読めなくもないですが、
もし、そういうことだった場合は、きちんと補足説明してください。

> そのシート「*A」とその他のシートをコピーして
これでは、条件づけとして無意味ですよね？
　　Dim sSH1(10) As String
と宣言していますが、
　　sSH1(0)　　ついでに　　sSH2(0)
は何に使うのか、
　　sSH1(6),sSH1(7),sSH1(8),sSH1(9),sSH1(10)
は何に使うのか
コードでも文語でも表記（説明）がありませんから
必然的にこちらが用意する回答の確かさが低くなってしまいます。

配列の扱いについてですが
　　Array(sSH1(2), sSH1(3), ... , sSH2(30))
Array関数の引数に配列の要素一点ずつ列挙、というのは、
かなり特殊な使い方で、今回のような目的には使いません。
また、sSH1(1)は何の為に配列変数に組み込むのか目的が理解できません。
この点についても説明がないのは困惑してしまいます。
配列変数を使うのでしたら、必要十分、過不足のない配列を作ってから
　　Worksheets(配列変数).Copy
という風に使うのが妥当なのではないでしょうか。

以上の問題点を踏まえて、今こちらが把握できているニーズに対する応え
として、
こちらでコードを書いてみました。
そのまま使えるほどには、こちらの理解が十分ではないだろうと感じていますが、
"何故そう書き換えているのか"解り易いように書いたつもりですので、
参考にしてもらえれば、と思います。
そちらで手に余って修正を必要とするようでしたら、
以下のコードを実際に試した上で、その結果と求める結果とがどう違うのか
または、上述のように不足した情報を補足するように
具体的な説明を一発で返してください。
こちらの理解が満ちたなら、再レスすることに抵抗はありません。

　　"*A*" でヒットするシートの数が
　　　　０　ならば、
　　　　　　"い" , "う" , "え" , "お" , "あ"
　　　　１以上　ならば
　　　　　　"い" , "う" , "え" , "お" , ＋　"*A*" でヒットしたすべてのシート
という解釈で仕様設定しています。

Sub Re8061771a()

　　Dim SH As Worksheet
　　Dim strString As String
　　Dim sSH1()　As String
　　Dim IngCnt As Integer

' ' コピー元のブック（適宜指定◆）（この場合はThisWorkbook）を確実にActivate
　　ThisWorkbook.Activate
' ' 念の為、作業グループ（複数シート選択状態）を解除しておくこと（.Selectじゃなきゃ意味ない）
　　ActiveSheet.Select

' ' シート名の配列を大き目にリサイズ（ 1 Origin ）
　　ReDim sSH1(1 To 255)
' ' "*A*" 以外のシート名を格納
　　strString = "あ"
　　sSH1(1) = "い"
　　sSH1(2) = "う"
　　sSH1(3) = "え"
　　sSH1(4) = "お"

' ' "*A*" 以外のシート名を設定した数
　　IngCnt = 4 ' ' 要指定◆！！

　　For Each SH In Worksheets

　　　　If SH.Name Like "*A*" Then
' ' カウンタ（IngCnt）の増分は処理済のシート数と同じなる様に、この位置
　　　　　　IngCnt = IngCnt + 1
' ' "*A*" シート名格納
　　　　　　sSH1(IngCnt) = SH.Name

　　　　End If

　　Next

　　If IngCnt = 4 Then ' ' 要指定◆！！ "*A*" 以外のシート名を設定した数
' ' "*A*" シートが見つからない場合は５番目のシートに strString"あ"
　　　　sSH1(IngCnt + 1) = strString
' ' カウンタ（IngCnt）を１増
　　　　IngCnt = IngCnt + 1

　　End If

' ' シート名の配列を IngCnt に合わせてリサイズ。Preserve キーワード必須
　　ReDim Preserve sSH1(1 To IngCnt)

' ' シート名の配列を元にコピー
　　Worksheets(sSH1).Copy

　　ActiveWorkbook.SaveAs Filename:="C:\Users\monkey-cr\Desktop\こぴ３.xls", _
　　　　　　　　　　　　FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
　　　　　　　　　　　　ReadOnlyRecommended:=False, CreateBackup:=False

End Sub

この回答へのお礼

cj_mover様

　早速の回答、そして詳細な内容を
　ありがとうございました。
　また私の意向（表記）不足の指摘もいただき
　重ねてお礼を申し上げます。

　質問をさせていただきましたマクロは
　処理依頼を頂いた会社ごとに
　資料を作成するマクロで

　sSH1(1)～(10）は
　　【パターン１】の会社では(1)～(5)のシート
　　【パターン２】の会社では(6)～(10)のシート
　　で資料を作成。

　*A*でヒットするシートというのは
　依頼データに日付があり月単位で
　データ明細のシートを作成(例：8月A・9月A…）。

　　パターン１or２の資料＆データ明細(*A*)で
　　依頼会社ごとのファイルを作成する。

　　という内容のVBAの一部なんです。

　　
　　回答してくださったマクロを参考に
　　早速、会社で修正してみます！

　　修正結果で上手く出来なかったら
　　来月中にまた質問させてください。
　　　　
　　マクロそのものは随分前に在籍されていた
　　社員さんが作成されたようで
　　まずは、そのマクロを解読することから
　　始めたという状態でした。
　　ほんの少しだけの知識しか持っていない
　　派遣にこんな事まで任せるか…。という
　　気持ちもありますが
　　せっかくのチャンスと思って
　　頑張ってみます。
　　↑ 余談でしたスミマセン。

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

お礼日時：2013/04/28 10:54

No.3 回答者： pidum 回答日時： 2013/04/27 23:49

発想を逆にして、先にブック名をこぴ３.xlsで保存し、指定シート名以外を削除する方法は如何ですか？

以下はマクロの一例です。
Worksheets("開始").Activateは下記マクロには不要でしたので削除しました。


Sub Macro3()

Dim Sh As Worksheet
Dim sSH1(10) As String
Dim i As Integer
Dim Fdir, fname As String

sSH1(1) = "あ"
sSH1(2) = "い"
sSH1(3) = "う"
sSH1(4) = "え"
sSH1(5) = "お"

Fdir = "C:\dumy\"
fname = "こぴ３.xls"

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Fdir & fname, _
FileFormat:=xlExcel8


For Each Sh In Sheets

If Sh.Name Like "*A*" Then GoSub end_for

For i = 2 To 5
If Sh.Name = sSH1(i) Then GoSub end_for
Next

Sh.Delete

end_for:

Next

Workbooks(fname).Close saveChanges:=True
Application.DisplayAlerts = True

End Sub

この回答へのお礼

pidum 様

　回答、ありがとうございました。
　先にブックから作成するという考えは
　全く思いつきませんでした！

　改めてマクロ作成には
　構築するセンスや想像力の豊かさが
　必要なのだと痛感いたしました。

　参考にさせていただきます。

　

お礼日時：2013/04/28 10:59

No.1 回答者： JazzCorp 回答日時： 2013/04/27 14:42

2000でもエラーにナル、ダッセェ～、、、