非表示セルや結合セルを無かったことに・・・選択範囲を見たままコピペ

非表示セルや結合セルを含んだ範囲を普通にコピーし、他のセルへ値貼り付けしたら･･････。

下のように、値が飛び飛びになってしまいます。

f:id:kouten0430:20180922133855j:plain

これを、マクロで飛び飛びにならないようにしてみましょう。

f:id:kouten0430:20180922134031j:plain

コードはこちらです。

Sub Tab改行区切りでクリップボードに格納()
    Dim i As Long
    Dim j As Long
    Dim myLib As Object
    Set myLib = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '参照設定なしでDataObjectのインスタンスを生成する
    
    If Selection.Areas.Count > 1 Then   '複数の矩形範囲が選択されている場合は終了する
        MsgBox "一つの矩形範囲のみ選択して再度実行して下さい。"
        Exit Sub
    End If

    For i = Selection.Row To Selection.Rows(Selection.Rows.Count).Row
        For j = Selection.Column To Selection.Columns(Selection.Columns.Count).Column
            If Cells(i, j).Address = Cells(i, j).MergeArea(1).Address And _
            Rows(i).Hidden = False And Columns(j).Hidden = False Then '結合セルの場合は左上の値のみ取り出す。非表示セルは処理しない
                If Cells(i, j).MergeArea(1).Address = Cells(i, Selection. _
                Columns(Selection.Columns.Count).Column).MergeArea(1).Address Then
                '選択範囲の最終列（最終列を含む結合セル）であれば末尾に改行を追加
                    If InStr(Cells(i, j), vbLf) = 0 Then
                        V = V & Cells(i, j).Value & vbCrLf
                    Else
                        V = V & """" & Cells(i, j).Value & """" & vbCrLf    'セル内改行があれば前後を""で囲む
                    End If
                Else
                '選択範囲の最終列（最終列を含む結合セル）以外は末尾にTabを追加
                    If InStr(Cells(i, j), vbLf) = 0 Then
                        V = V & Cells(i, j).Value & vbTab
                    Else
                        V = V & """" & Cells(i, j).Value & """" & vbTab   'セル内改行があれば前後を""で囲む
                    End If
                End If
            End If
        Next j
    Next i
    
    V = Left(V, Len(V) - 2) '最終行の改行区切りを取り除く（CrLfは2文字）
    
    myLib.SetText V  '変数の値をDataObjectに格納する
    myLib.PutInClipboard 'DataObjectのデータをクリップボードに格納する
    
End Sub

コピーしたい範囲を選択してから、マクロを実行します。

値が飛び飛びにならないよう加工され、クリップボードに転送されます。好きなセルへ値貼り付けして下さい。（コピーはマクロで、貼り付けは標準機能で行うという流れです）

※コードの大まかな説明

まず、複数の矩形範囲が選択されている場合は意図通りに処理することができないので、プロシージャを強制終了します。
次に、下方向をｉ、右方向をｊとして、選択範囲を左上から右下までループ処理します。処理内容は、各セルの値にTabまたは改行を付け足します。（列と列の間にはTabを、行と行の間には改行が入るようにする）
もし、上記の処理を非表示セルや結合セル（の左上以外）にも行うと･･････最終的に下のようなデータが出来上がります。
･･････が、これでは普通にコピーしたのと同じで、値貼り付けをすると「画像１」と同様になります。（逆にいうと、これが普通にコピーしたら飛び飛びになってしまう理由です）
なので、非表示セルや結合セル（の左上以外）には処理を行わないようにしましょう。そうすると、最終的に下のようなデータが出来上がります。
これを値貼り付けすると「画像２」と同様になります。
最後に、このデータをクリップボードへ転送します。