名前を付けたセルを別のブックにコピーしたときの位置

Question

Excel2003　の名前を付けたセルのコピーについて質問です。
例えばI列より左側には大量のデータがあって、J列より右にはそのデータのまとめを作ったとき、

J3を基準として、J3、J4、K3にそれぞれ結果１、結果２、結果３という名前を付けるとします。
VBAマクロでこの結果１、２、３を読み込ませているのですが、このファイルを雛型として、別のファイルにもこの「データのまとめ」エリアとマクロをコピーするとき、いつもJ3を基準とするとは限らないので困っています。

データの数によっては基準がL3になったりしてもかまわないようにしたいのです。
ところが、J～K列を新しいブックのL列へとコピーすると、J3、J4、K3のセル内容はL3、L4、M3に当然コピーされるのですが、
結果１、結果２、結果３という名前のついたセルはJ3、J4、K3のままなので、困っています。

マクロで「L3を結果１と呼ぶ」
ActiveWorkbook.Names _
            .Add Name:="結果１", _
            RefersToR1C1:="=Sheet1!R3C12"
という方法しか解決策はないでしょうか？

マクロを使わなくても、コピーペーストのやり方次第でL列でもP列でも任意の列に「名前のついたセル」をセルごと持っていく（名前だけが別のセルにならない）、という方法があれば、一番簡潔（マクロを組まなくて良い）ので特にありがたいです。よろしくお願いします。

（自力で検索して同様の質問は見つけられなかったのですが、既出でしたら、検索方法やリンクや参照ページだけでも教えていただけたらありがたいです。）

ap_2 · Accepted Answer

補足＠ANo.1です。

シート間の"名前"の移動は、コピー範囲内で"名前"が使われている場合のみ、かと。ANo.1の1(×J3,○J～L列でした)も、J～L列に、名前つきセルと、名前使用セルを含むことが前提です。ANo.2最後の、相対使って表組みなおす方がスマートかも。

VBAは、ANo.1では面倒と書いたけど・・・使い捨てる分には簡単。作れると楽ですよ。名前コピーされてるならAddじゃ重複します。以下、参考程度に＠動くか不明
'貼り付け先を選択してペースト代わりに実行。
Sub sample()
　ActiveSheet.Paste
　n = Selection.Cells(1, 1).Column - Range("J1").column　'コピー元(J?)とのズレ
　With Activeworkbook.Names("結果１")
　　.RefersToR1C1 = "=R" & .RefersToRange.row & "C" & .RefersToRange.column + n
　end with
　With ...Names("結果2")
　'以下略
End Sub

汎用的な処理のイメージが沸かず、つい考え込みました。やっぱりコピー元"Book"の判別にすら要ClipBoard操作みたい。あきらめタ！
コード書く気なかったんですが、このもやもやを伝えたくて（－－；

ap_2 · Answer

「名前」も、あくまで「絶対参照」。セルに"=$A$1"と書くのと同じなので、コピー時に参照元（対象)が変わっちゃ困りマスね。

で、どーすればよいか。
　1. 「参照元」をカット＆ペーストでズラす ←☆
　2. 名前を「式」で作り、相対っぽくする
　3. VBAで特別な処理を作る

☆1。同一シート内に限り、参照元をカット＆ペーストで移動できます。名前"=$A$1"なら、A1をカットしB1にペーストすれば、"=$B$1"に。
そこで、J3→別シートJ3にコピーした後、J3→L3にカットで移動。J3にデータがある場合は、新規Bookで仲介したらいいです。絶対参照ズラすのによく使う手。
こんなんじゃダメかな・・・？

2。名前には、OFFSETやMATCHなどの関数が使えます。一定範囲内で見出し「合計」のセルを探して・・・とか、曖昧な参照も可能。でも、デリケートで扱いづらいためオススメしません。

3。地味にめんどくさい・・・デスヨ。

queuerev2 · Answer

雛形の名前つきセルのあるシートをコピーしてそこにデータを貼り付けるのがもっとも簡明だと思いますが、おそらく質問者様のやり方には合わないのでしょうね。

マクロを使わずに名前つきのセルを名前ごとコピーするには、やや手順はかかりますが以下のような方法があります。
１．雛形の名前つきセルのあるシートを名前つきセルを貼り付けたい別のブックにコピーする
（雛形の名前つきセルのあるシートで「セルの移動またはコピー」→「コピーを作成する」をチェック→「移動先ブック名」にて名前つきセルを貼り付けたい別のブックを選択→OK）
２．コピーしたシートから目的のシートへ名前つきセルを移動
（コピーしたシートの名前つきセルを含む領域を選択→切り取り→目的のセルに貼り付け）
３．コピーしたシートを削除

しかしこのような手順を毎回行うくらいなら、名前をつけるマクロを作成したほうが楽で確実だと思います。

ところで、質問文中で１つわからないところがあります。
>結果１、結果２、結果３という名前のついたセルはJ3、J4、K3のままなので、困っています。
このJ3、J4、K3はどのシートなのでしょうか。もしも貼り付け先のセルであれば、あとはセルの移動や行の挿入・削除で名前つきセルを動かすことができます。
しかしこちらでテストしたところでは、単純な列のコピーでは名前はコピーされませんでしたので、おそらくコピー元の雛形のほうなのでしょう。

あとは、たとえばデータのあるセルのどこか一定の位置に名前をつけておき、そこからの相対参照を行う方法もあると思います。
ただし既存のマクロの書き換えが必要になりますが。

queuerev2 · Answer

No.2です。
いただいたお礼に対する返答のみにて新規提案がありませんが失礼致します。

>「セルの移動またはコピー」
>の機能メニューは見つけられなかったので、
>「シートの移動またはコピー」
>で代用しました。
>これでも良かったでしょうか？

「シートの移動またはコピー」が正しいのですが誤記してしまいまし申し訳ありません。
また、質問者様には丁寧なお礼をいただき、質問者様とNo.1,3様の豊富な知識に逆にこちらが勉強になりました。
ありがとうございました。

ap_2 · Answer

ANo.1＆3です。
丁寧なお礼（あまりの長さに笑った）に加え、回答者からもコメントもらって、悪い気はシナイ！見栄はって頑張りたくなっちゃいますｗ

上司からの要望でしたか、悩ましいですよね＾＾；

※ もーちょい補足
「名前」という名前が悪い。コレ「定数」です。
セルに名前を・・・ではなく、アドレスに名前をつける機能。そう考えると納得できるかと。

式の中で "名前" が "アドレス" に置き換わるだけなので、コピー時などは　セルに"=$A$1"と入力した場合　と同じ扱いになります。
名前使用セルのコピペで名前定義が挿入されるのは、「名前がない！」を避けるためのサービスなんでしょうね。

ap_2 · Answer

ClipBoard操作のコード見つけたんで、ためしに使って作ってみました。解決済みっぽいけど、自己満足ってコトデ。 WindowsAPIに抵抗ある場合は、コード前半は無視してMyCopyFuncをコメント解除して使用。Copy処理もマクロ化することでコピー元を保持します。Ctrl+Shif+C/Pとかキー割り当てれば、案外使えるかなと。こんな感じで「絶対参照を無視してコピペ」とか作ると便利かも。 '--> ClipBoard操作する場合ここから 'マクロの使用はペースト時のみでOK '※アドレス取得まる写し。takanaさんに感謝(-人-) 'ttp://hpcgi1.nifty.com/MADIA/VBBBS/wwwlng.cgi?print+200910/09100010.txt Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long) 'コピー元アドレス取得 Public Function GetCopyAddress() As String 　Dim lngFormat&, hMem&, lngSize&, strData() As Byte, i& 　OpenClipboard 0 　hMem = GetClipboardData(RegisterClipboardFormat("Link")) 　If hMem = 0 Then 　　CloseClipboard: Exit Function 　End If 　lngSize = GlobalSize(hMem) 　ReDim strData(0 To lngSize - 1) 　MoveMemory(VarPtr(strData(0)), GlobalLock(hMem), lngSize) 　GlobalUnlock hMem 　CloseClipboard 　For i = 0 To lngSize - 1 　　If strData(i) = 0 Then strData(i) = Asc(" ") 　Next i 　GetCopyAddress = AnsiToUnicode(strData()) End Function Private Function AnsiToUnicode(ByRef strAnsi() As Byte) As String On Error GoTo ErrHnd 　Dim lngSize&, strBuf$, lngBufLen&, lngRtnLen& 　lngSize = UBound(strAnsi) + 1 　lngBufLen = lngSize * 2 + 10 　strBuf = String$(lngBufLen, vbNullChar) 　lngRtnLen = MultiByteToWideChar(0, 0, strAnsi(0), lngSize, StrPtr(strBuf), lngBufLen) 　If lngRtnLen > 0 Then AnsiToUnicode = Left$(strBuf, lngRtnLen) ErrHnd: End Function '※まる写しココマデ 'コピー元Range取得 Private Function GetCopyRange() As Range 　Dim re, mt, adr$ 　adr = GetCopyAddress 　Set re = CreateObject("VBScript.RegExp") 　re.Pattern = "Excel .*$$(.+)$$(.+) ([RC0-9:]+)" 　Set mt = re.Execute(adr) 　If mt.Count <> 0 Then Set GetCopyRange = Workbooks(mt(0).submatches(0)).Sheets(mt(0).submatches(1)).Range(Application.ConvertFormula(mt(0).submatches(2), xlR1C1, xlA1)) End Function <-- ClipBoard操作ここまで '--> WindowsAPIに抵抗あるならコチラ(要コメントアウト) 'コピー操作はMyCopyFuncで。コピーついでにコピー元を保持。 ''(名前定義コピペ) コピー処理 'Function MyCopyFunc() '　GetCopyRange Selection: Selection.Copy 'End Function ''Range保持/取得用＠グローバル変数でもいいんだけど 'Private Function GetCopyRange(Optional ByVal rng As Range) As Range '　Static target As Range '　If Not (aRng Is Nothing) Then target = rng '　Set GetCopyRange = target 'End Function '<-- WindowAPIナシ版ここまで '--> 以下、共通 '(名前定義コピペ) ペースト処理 Sub MyPastFunc() 　Dim nmlist(1 To 100), rng As Range, i&, n&, o 　ActiveSheet.Paste 　'セルコピー以外終了　If Application.CutCopyMode <> xlCopy Then Exit Sub 　Set rng = GetCopyRange 'コピー元取得　If rng Is Nothing Then Exit Sub 　'コピー範囲に含まれる名前を取得　On Error Resume Next 'Range.Nameは有無不明　For Each o In rng 　　Set nmlist(n + 1) = o.Name 　　If nmlist(n + 1) <> Empty Then n = n + 1 　Next 　On Error Goto 0 　If n = 0 Then Exit Sub 　Dim dr&, dc&'位置ズレ取得　dr = Selection.Cells(1, 1).Row - rng.Cells(1, 1).Row 　dc = Selection.Cells(1, 1).Column - rng.Cells(1, 1).Column 　'名前定義の挿入/差替え　For i = 1 To n 　　ActiveWorkbook.Names.Add nmlist(i).Name, "=R" & (nmlist(i).RefersToRange.Row + dr) & "C" & (nmlist(i).RefersToRange.Column + dc) 　Next End Sub

名前を付けたセルを別のブックにコピーしたときの位置

「名前」も、あくまで「絶対参照」。

雛形の名前つきセルのあるシートをコピーしてそこにデータを貼り付けるのがもっとも簡明だと思いますが、おそらく質問者様のやり方には合わないのでしょうね。

補足＠ANo.1です。

No.2です。

ANo.1＆3です。

ClipBoard操作のコード見つけたんで、ためしに使って作ってみました。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング