【Excel VBA】可視セルのみコピー、可視セルにのみ貼り付ける方法

皆さんは可視セルのみコピーして、可視セルにのみ貼り付けたいと思ったことはありませんか？

今回はそのような方に方法をご紹介します。

可視セルのみコピー

こちらは非常に簡単です。

Sub test()
    
    Selection.SpecialCells(xlCellTypeVisible).Copy
    
End Sub

これで選択範囲の可視セルのみがコピーされます。

可視セルにのみ貼り付け

次に、可視セルにのみ貼り付ける方法です。

こちらはセルが非表示かどうかを判定しているため長いコードになっています。

Sub test2()
 
    Dim dob As Object
    Dim clp_ary As Variant
    Dim clp_txt As String
    Dim i As Long
    Dim lj As Long
    Dim dat_num As Long
    Dim end_flg As Boolean
    Dim clp_col_ary As Variant
    Dim k As Long
    Dim cj As Long
    Dim total_col_offset As Long
    
    Application.ScreenUpdating = False
 
    Set dob = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    dob.GetFromClipboard
    If Not dob.GetFormat(1) Then
        MsgBox "中止します。" & vbCrLf _
             & "貼付できるのは、文字データのみです。" & vbCrLf _
             & "(Excelのセル、画像などは貼付不可)" _
             , _
             , "PastInFltr"
        Exit Sub
    End If
     
    clp_txt = dob.GetText
    '行方向の分割
    clp_ary = Split(clp_txt, vbCrLf)
    If vbCrLf = Right(clp_txt, 1) _
        Or vbLf = Right(clp_txt, 1) Then
        dat_num = UBound(clp_ary)
    Else
        dat_num = UBound(clp_ary) + 1
    End If
     
    end_flg = False
    For i = 0 To dat_num - 1
        lj = 0
        '行方向
        If ActiveCell.EntireRow.Hidden Then
            Do While ActiveCell.Offset(lj, 0).EntireRow.Hidden
                lj = lj + 1
            Loop
             
            ActiveCell.Offset(lj, 0).Select
        End If
        '列方向の分割
        clp_col_ary = Split(clp_ary(i), vbTab)
        total_col_offset = 0
        For k = 0 To UBound(clp_col_ary)
            cj = 0
            If k = 0 Then
                ActiveCell.Value = clp_col_ary(k)
            Else
                If ActiveCell.EntireColumn.Hidden Then
                    Do While ActiveCell.Offset(lj, cj).EntireColumn.Hidden
                        cj = cj + 1
                        total_col_offset = total_col_offset + 1
                    Loop
                End If
                ActiveCell.Offset(0, cj).Select
                
                ActiveCell.Value = clp_col_ary(k)
            End If
            ActiveCell.Offset(0, 1).Select
            total_col_offset = total_col_offset + 1
        Next
        
        '次のセル位置へ
        ActiveCell.Offset(1, -total_col_offset).Select
    Next i
 
    Application.ScreenUpdating = True
 
End Sub

上記コードを実行すると可視セルにのみ貼り付けることができます。