【VBA】可視セル(フィルタ結果)を配列を使って高速にコピーする方法

日々の業務で大量のデータから特定の情報を抽出し、別のシートやワークブックへ移動させる作業は多いでしょう。特にフィルタを適用した結果だけを取り出す場合、手作業では時間がかかります。この記事では、VBAを使用して可視セル（フィルタ結果）を高速にコピーする方法を紹介します。

サンプルコード

VBA

Option Explicit
Sub CopyVisibleCells()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRowSrc As Long, lastColSrc As Integer, i As Long, j As Integer
    Dim arrData() As Variant
    
    ' ソースとターゲットのワークシートを指定
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsTarget = ThisWorkbook.Sheets("Sheet2")
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' ソースシートの最終行と列を取得
    lastRowSrc = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    lastColSrc = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
    
    ' 配列に可視セルのデータを格納
    ReDim arrData(1 To lastRowSrc - wsSource.Rows("1:1").SpecialCells(xlCellTypeVisible).Count + 1, 1 To lastColSrc)
    For i = 1 To lastRowSrc
        If wsSource.Rows(i).Hidden Then GoTo NextIteration
        For j = 1 To lastColSrc
            arrData(i - wsSource.Rows("1:1").SpecialCells(xlCellTypeVisible).Count + 1, j) = wsSource.Cells(i, j)
        Next j
    Next i
NextIteration:
    
    ' ターゲットシートに配列のデータを貼り付け
    With wsTarget.Range("A1").Resize(UBound(arrData), UBound(arrData, 2))
        .Value = arrData
    End With
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

よくある質問

Q 元に戻せますか？

VBAの実行結果は「元に戻す」が効きません。必ずバックアップを取ってから実行してください。

Q エラーが出たら？

シート名や列番号が正しいか確認してください。