可視セルから可視セルへのコピー

質問

エクセルのデータ集計で集計された数字（可視セル）を他のファイルの表にコピーしたいのです。
通常、編集→ジャンプから可視セルを選びコピー→形式を選択して貼り付けから値を選び
貼り付けているのですが、今回は表の方にも非表示にしている行があるのです。
なので通常の方法でやると表の方の非表示セルに値が貼りついてしまい困ってます。
可視セルの値を表の可視セルへコピーする方法はないのでしょうか？

回答No.3

Wendy02 · ベストアンサー

#2 のpascal3141さんへ
＞ActiveSheet.Paste
貼り付け側にも、非表示セルがあるのですね。だから、そのまま貼り付けは出来ませんね。

bonbonkogepan さん、こんばんは。

やっと、形がまとまりました。
[Alt]を押しながら[F11] を押して、Visual Basic 画面を開けたら、挿入－標準モジュールで、画面を出します。そして、以下を貼り付けます。
一旦、保存してから、再び、このブックを起動したら、マクロが設定されます。

使い方：
コピーする可視セルの範囲をマウスで選択して、
「Ctrl + C（Ctrlキーを押しながら、C」とすると、
メッセージが出てきます。
（メッセージは、不要になったら、MsgBox の代わりに、Beep という単語だけを書くと、音だけします。）

次に、コピーされる側のセルに移り、「Ctrl + V」とします。

　　ショートカットは、自分で変えられます。
　　+ がShift, ^ がCtrl, % がAlt です。
　　ファンクションキーは、{F1}, {F2}…… となります。
　　取り外し側で、同じよう書けば残りません。また、Excel自体を終了しても残りません。もし、[Personal.xls] に同じように書けば、全体のブックに設定されます。

　※現在のバージョンは、非表示行に対してのみです。

なお、作った本人は、今のコードを気に入っています。このご質問はとてもユニークです。ですから、もっと別な人のアイデアを見たいものです。また、作っている途中で、セルの自体のコピー（書式等を含めて）の仕方も思いつきました。それから、これは、Excelの持っているクリップボードを使えば、もっと完璧になりますが、掲示板の性格上、そこまではしませんでした。

'--------- 切り取り線 -----------------------
'<標準モジュール登録>
Option Explicit
Private rng As Range
Private copyFlg As Boolean
Sub Auto_Open()
　Call SettingKey
End Sub
Sub Auto_Close()
　Call SettingOffKey
End Sub
Sub SettingKey()
'設定ショートカット
With Application
　　　 .OnKey "%c", "VisibleCopy" 'コピー　Alt+ C
　　　 .OnKey "%C", "VisibleCopy"
　　　 .OnKey "^v", "VisiblePaste"　'貼り付け　Ctrl+ V
　　　 .OnKey "^V", "VisiblePaste"
End With
End Sub
Sub SettingOffKey()
'設定ショートカットの取り外し
With Application
　　　 .OnKey "%c"
　　　 .OnKey "%C"
　　　 .OnKey "^v"
　　　 .OnKey "^V"
End With
End Sub
'---実行部分-------
Sub VisibleCopy()
　Set rng = Selection.SpecialCells(xlCellTypeVisible)
　copyFlg = True
　MsgBox "Ctrl +V で貼り付けしてください", 64　'覚えたら、外してネ!
　'Beep
End Sub
Sub VisiblePaste()
　Dim c As Range, cnum As Long
　Dim myArray() As Variant
　Dim i As Long, j As Long
　If copyFlg = False And rng Is Nothing Then Exit Sub
　cnum = rng.Areas(1).Columns.Count
　For Each c In rng
　　ReDim Preserve myArray(i)
　　'配列に格納
　　myArray(i) = c.Value
　　i = i + 1
　Next c
　With ActiveCell
　　j = 0
　　For i = LBound(myArray) To UBound(myArray)
　　　Do While .Offset(j, j).EntireRow.Hidden = True
　　　　j = j + 1
　　　Loop
　　　.Offset(j, (i + cnum) Mod cnum).Value = myArray(i)
　　　If (i + cnum) Mod cnum = cnum - 1 Then j = j + 1
　　Next i
　End With
End Sub

お礼

朝から会社で上記をコピーしてやってみました。
VBAは全くわかりませんので何度かエラーが出てどうしよー！？っと焦ってたのですが、
ようやく成功しました！！
完璧です！！！
これで貼り付ける方の表の非表示部分に合わせてこま切れにコピーせずにすみます。
私がこの仕事をしている限りずっとこのコードを使い続けます。
良回答20点なんて足りませんね。
ホント何百点、何千点と付けたい気持ちです。
本当にありがとうございました！

ちなみにWendy02様は
＞ですから、もっと別な人のアイデアを見たいものです。
とのご意向ですのでこの質問はしばらく締め切らずに置いておきます。

回答No.4

Wendy02

#3の修正分:　ショートカットキーは、バッティングすると前のものが無効になってしまいます。Ctrl + V とは共用すべきではありませんでした。Alt + X は、ちょっと近すぎるような気がします。ショートカットキーの空いたところを探して、設定してもよいです。

Option Explicit
Private rng As Range
Private copyFlg As Boolean
Sub Auto_Open()
　Call SettingKey
End Sub
Sub Auto_Close()
　Call SettingOffKey
End Sub
Sub SettingKey()
'設定ショートカット
With Application
　　　 .OnKey "%c", "VisibleCopy" 'コピー　Alt+ C
　　　 .OnKey "%C", "VisibleCopy"
　　　 .OnKey "%x", "VisiblePaste"　'貼り付け Alt+ X
　　　 .OnKey "%X", "VisiblePaste"
End With
End Sub
Sub SettingOffKey()
'設定ショートカットの取り外し
With Application
　　　 .OnKey "%c"
　　　 .OnKey "%C"
　　　 .OnKey "%x"
　　　 .OnKey "%X"
End With
End Sub
Sub VisibleCopy()
　Set rng = Selection.SpecialCells(xlCellTypeVisible)
　copyFlg = True
　MsgBox "Alt +X で貼り付けしてください", 64　'覚えたら、外してネ!
End Sub
Sub VisiblePaste()
　Dim c As Range, cnum As Long
　Dim myArray() As Variant
　Dim i As Long, j As Long
　If copyFlg = False And not rng Is Nothing Then
　　　　rng.Paste ActiveCell
　　　 Exit Sub
　End If
　cnum = rng.Areas(1).Columns.Count
　For Each c In rng
　　ReDim Preserve myArray(i)
　　'配列に格納
　　myArray(i) = c.Value
　　i = i + 1
　Next c
　With ActiveCell
　　j = 0
　　For i = LBound(myArray) To UBound(myArray)
　　　Do While .Offset(j, j).EntireRow.Hidden = True
　　　　j = j + 1
　　　Loop
　　　.Offset(j, (i + cnum) Mod cnum).Value = myArray(i)
　　　If (i + cnum) Mod cnum = cnum - 1 Then j = j + 1
　　Next i
　End With
End Sub

お礼

夜遅くまでありがとうございました。
こちらのコードを採用させていただきました。

回答No.2

pascal3141

この方法ではいけませんか？
今みている可視セルを、Sheet2にコピーするマクロです。標準モジュールに書いてください。

Sub CopyVisual()
'アクティブセル選択
Range("A1").CurrentRegion.Select
'可視セルコピー
Selection.SpecialCells(xlCellTypeVisible).Copy
'別シートにはりつけ
Worksheets("Sheet2").Select
ActiveSheet.Paste

Application.CutCopyMode = False

End Sub

回答No.1

Wendy02

ご質問としては面白いのですが、実際、朝から考えて、良い案が出てきません。
残念ながら、VBAでしか処理することは不可能だと思います。

コピーという範疇ですが、書式などを含めてコピーなのですか？
それとも、値だけで良いのでしょうか？
それによって、コードが変ってきます。
と、言って、できるかどうか、まだ分かりません。

補足

Wendy02様、毎度お世話になります。
朝から考えていてくださってたとは！
頭が上がりませんm(__)m
可視セルから可視セルへのコピー…
ありがちだと思うんですけどねぇ。
普通にするぶんには無理なんですね。
補足ですが、コピーは値のみになります。
もし出来たらでいいんでお願いします。
いつまでもお待ちしております。