時々、入力するよう渡されたエクセルのファイルで、シートのコピーをしようとすると、領域名のエラーが大量に出てしまう事がありまして。また当たってしまったのでその処理の覚書き。（☆環境はWindows8.1 Excel2013 ですが、多分バージョン関係なく出ると思います。） こんな感じのヤツ数個程度なら［はい(Y)］を押せばいいのですが、何百個（もしかしたら何千？※）になるとウンザリしてきますし、効率が悪くて仕事にならない。（※マクロを使ってカウントさせてみたら2万以上ありました・・・＞＜） なんでこうなるのか原因がいまいちよく分からないのですが、使用できない文字が領域名に使われているとか？ 書類のテンプレートとして沢山の人・沢山のプロジェクトで使いまわされて上書きを繰り返されたファイルがなるとか？ ｢Y｣キーを押しっぱなしにして気長に待てはいずれ終わりますが ※終わった後セルにYYYYYYYと入力されてしまいますので何もないセルを選択した状態でやりましょう(笑) それでも大量にあると結構待たされます。シートを複数コピーしたい時など毎回出るのでは仕事にならない(-_-;) この領域名を削除するには
スポンサーリンク
■方法１ ［数式］→［名前の管理］で出るダイアログから削除できます削除できるはず・・・ 出来た人はおめでとうございます。 しかぁし！ 全部選択して削除ボタンを押すと、ダイアログ内も空白になり成功したように見えますが、ダイアログを閉じてもう一度［名前の管理］を開いてみると、できてない・・・ こんな簡単にできるなら、多分エラー出てないですよね・・・(+_+)
■方法２ 検索してみると同様の問題で悩んでいる人は多いようで、 領域名を消してくれるマクロを作って下さっている方が居ます、有りがたい事です。 Server World 高密度商業地域 他にも、探すと結構たくさんありますね。 ところが・・・ 以前のバージョンのエクセルはこれらのシンプルなマクロで削除できていたのですが、2013だからでしょうか？今回はこれらのマクロでもうまく行きませんでした。
■方法３ こちら（trash-area.com）で解説されてた方法 オプションの中にある｢R1C1 参照形式を使用する(C)｣のチェック状態を入れてやると、［名前の重複］と言うダイアログが出てきて、名前の変更を求めらます。 いちいち手動で修正してられませんので、ランダムな名前を自動的につけさせてしまうマクロを書いてくださっています。 やってみました⇒ できた！！ ように見えたのですが・・・ ファイルを保存しようとすると、エラーで落ちてしまう・・・(＞＜) ザンネ～ン！！
■方法４ もうしょうがない、力技で(笑) シートの複写を使わずに、セルを全選択してコピー、新しいシートにペーストするとエラーが出ないようです。 新しいブックに張り付けてやれば、名前はついてこないで中身だけコピーできるようです。 シートの数が少なければこれで新しいファイルに保存しなおしてあげたほうが早いですね。 で、シートの数が多かったので面倒だったので、私もマクロを書いて処理しました。 すべてのシートを新しいブックの新しいシートに複写するマクロです。
Sub シート全て複写()
' エラー時の処理ルーチン
On Error GoTo Err
' クリップボードを空に
Application.CutCopyMode = False
' 現在のブック名取得
Dim SourceBook As String
SourceBook = ActiveWorkbook.Name
' 新規ブック作成
Workbooks.Add
' 新規ブック名取得
Dim TargetBook As String
TargetBook = ActiveWorkbook.Name
Windows(SourceBook).Activate
' ページ設定変数宣言
Dim strSheetName As String
Dim strPaperSize As String
Dim strOrientation As String
Dim intZoom As Integer
Dim strLeftMargin As String
Dim strRightMargin As String
Dim strTopMargin As String
Dim strBottomMargin As String
Dim strHeaderMargin As String
Dim strFooterMargin As String
Dim strView As String
Dim varPrintQuality As Variant
' 処理
For I = 1 To Worksheets.Count ' 繰り返し処理
Sheets(I).Select ' シート選択
' 現在シートの設定取得
strSheetName = ActiveSheet.Name
strPaperSize = ActiveSheet.PageSetup.PaperSize
strOrientation = ActiveSheet.PageSetup.Orientation
intZoom = ActiveSheet.PageSetup.Zoom
strLeftMargin = ActiveSheet.PageSetup.LeftMargin
strRightMargin = ActiveSheet.PageSetup.RightMargin
strTopMargin = ActiveSheet.PageSetup.TopMargin
strBottomMargin = ActiveSheet.PageSetup.BottomMargin
strHeaderMargin = ActiveSheet.PageSetup.HeaderMargin
strFooterMargin = ActiveSheet.PageSetup.FooterMargin
varPrintQuality = ActiveSheet.PageSetup.PrintQuality
strView = ActiveWindow.View
' セル全選択・コピー
Cells.Select
Selection.Copy
' Window切替
Windows(TargetBook).Activate
' 新規シート追加
Sheets.Add After:=ActiveSheet
' 貼り付け
ActiveSheet.Paste
' ページ設定
ActiveSheet.Name = strSheetName
ActiveSheet.PageSetup.PaperSize = strPaperSize
ActiveSheet.PageSetup.Orientation = strOrientation
ActiveSheet.PageSetup.Zoom = intZoom
ActiveSheet.PageSetup.LeftMargin = strLeftMargin
ActiveSheet.PageSetup.RightMargin = strRightMargin
ActiveSheet.PageSetup.TopMargin = strTopMargin
ActiveSheet.PageSetup.BottomMargin = strBottomMargin
ActiveSheet.PageSetup.HeaderMargin = strHeaderMargin
ActiveSheet.PageSetup.FooterMargin = strFooterMargin
ActiveSheet.PageSetup.PrintQuality = varPrintQuality
ActiveWindow.View = strView
' A1セル選択
Range("A1").Select
' 元ファイル選択・A1セル選択
Windows(SourceBook).Activate
Range("A1").Select
Next
Err:
Resume Next ' エラーの場合も次の処理続行
End Subこれでなんとか、無事クリーンなファイルにすることができました。＼(^o^)／
※やってみたら、一部書式の設定（印刷範囲・行の高さ等）が崩れるという問題点があった・・・orz セルの全選択からの書式のコピペでは、上記書式がコピーされないんですね 行を選択して書式のコピー→貼り付けなら反映されることが判明したので、取り急ぎ、応急修理で、マクロで全シート回してみた （後で時間があれば上記マクロと合成しよう）
Sub シート全て複写()
' エラー時の処理ルーチン
On Error GoTo Err
' クリップボードを空に
Application.CutCopyMode = False
For I = 1 To Worksheets.Count ' 繰り返し処理
Windows("コピー元のファイル名").Activate
Sheets(I).Select ' シート選択
Rows("1:150").Select
Selection.Copy
Windows("コピー先のファイル名").Activate
Sheets(I).Select ' シート選択
Rows("1:150").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Next
Err:
Resume Next ' エラーの場合も次の処理続行
End Sub取り急ぎの応急処置なので、「コピー元ファイル名」「コピー先ファイル名」は任意に直打ち コピーする行数は、必要に応じて修正 最終行取得マクロはさらにややこしくなるのでやめ(笑) 時間ができたらあとで組み込もう・・・ 印刷範囲は手動で設定しなおし。。。
コメント