上のセルの値だけをコピーするマクロ（フィルターしていてもOK)

上のセルの値だけをコピーしたい

Excelで上の行をコピーするショートカットキーの「Ctrl + D」。
便利だけど、フィルターされていると、実際の一行上のセルがコピーされるし、
また書式もコピーされるから色とか字体とかもコピーされる。
上のセルの値だけコピーしたいときあるよね？

例えば、

このような表で種目AAAでフィルターする。

この状態で「Ctrl + D」を押す。

すると、見えている状態（可視セル）の「123-456-789」でなくて、実際の一つ上のセルの「333-1123-456」が入力される。
（いつもフィルターしている事を忘れて失敗する）

また、こんな場合

上の行に色が付いている。
この場合は色ごとコピーされる。値だけでいいのに・・・。

上の値だけをコピーするショートカットキーが欲しい。

ということで、自作してみた。

一行上の可視セルの値だけをコピーするマクロ

①個人用マクロブック「PERSONAL.XLSB」にマクロを作成する

「PERSONAL.XLSB」にマクロを作成すれば、そのパソコンならどのエクセルファイルでも使える。

個人用マクロブックを一度も使っていない場合は「PERSONAL.XLSB」はないので作成する。

【作成方法】

開発タブのマクロの記録をクリック。

割り当てたいショートカットキーを入力する。
（コロ子は「Ctrl＋b」にした。）

マクロの保存先に「個人用マクロブック」を選択してOKボタンをクリック。

何か適当に操作して、マクロの記録を終了する。

VBEエディタを見ると「PERSONAL.XLSB」が作成されている。

ちなみに「PERSONAL.XLSB」はWindows10では
C:\Users\[user]\AppData\Roaming\Microsoft\Excel\XLSTARTに作成される。

②「PERSONAL.XLSB」の標準モジュールにコードを書く。

【考え方】
①カーソル位置より上の可視セルの範囲を取得する（複数列ある場合は先頭列のみ）

②取得した範囲の各々のセルの行番号を配列に格納する

③配列で2番目に大きい行番号が一行上の可視セル。
（一番大きい行番号はカーソル位置）

④一行上の行番号の範囲（カーソル位置と同じ大きさの範囲）をコピー

⑤カーソル位置に値のみを張り付ける

【コード】

Sub PasteValue()

Dim Myrange As Range
Dim MyRow As Long
Dim MyColumn As Long
Dim VisibleRange As Range

Set Myrange = Selection
MyRow = Myrange.Row
MyColumn = Myrange.Item(1).Column '選択範囲の先頭の列

'①MyColumn列の1行目からMyRow行目までの可視セルの範囲を取得
Set VisibleRange = _
Range(Cells(1, MyColumn), Cells(MyRow, MyColumn)).SpecialCells(xlCellTypeVisible)

Dim buf As Range
Dim RowArr() As Long
Dim i As Long

'②配列に行番号を格納する
i = 1
For Each buf In VisibleRange
    
    ReDim Preserve RowArr(i)
    
    RowArr(i) = buf.Row
    i = i + 1

Next buf

'③RowArr配列の2番目に大きい数字（一行上の行番号）を取得する
Dim OneUpRow As Long
OneUpRow = WorksheetFunction.Large(RowArr, 2)

'④一行上の行番号の範囲をコピー
Myrange.Offset(-(MyRow - OneUpRow), 0).Copy

'⑤値のみ貼り付け
Myrange.PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

End Sub

これで「Ctrl＋b」で上の可視セルの値だけがコピーできる！

すごく便利だったから、職場で「このマクロいる？」ってみんなにメールしてみたけど、誰からも反応は無かった。
一般的な需要じゃないのか・・・。

ちなみに新しく「PERSONAL.XLSB」を作った場合は、エクセルを開くたびに、「PERSONAL.XLSB」も一緒に開くので表示タブの「表示しない」を選択し、非表示にしておけばOK。