【エクセルマクロ】色のついたセルを別シートに抽出(動画あり)

エクセルマクロ_色付きセルを別シートに抽出_アイキャッチ ExcelVBA

エクセルマクロで、色付きのセルを別シートに抽出するVBAコードをご紹介します。

このページのマクロコードは、コピペで使えます。
ぜひお試しください!

色付きセルを別シートに抽出

以下のマクロを実行すると、色のついたセルを別シートへ転記します。


Sub 色がついているセルを別のシートへ転記()

Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim LastRow As Long
Dim i As Long
Dim j As Long

    j = 2
    
    Set Sh1 = Sheets("Sheet1")
    Set Sh2 = Sheets("Sheet2")
    
    '最終行を取得
    LastRow = Sh1.Cells(Rows.Count, 1).End(xlUp).Row
    
    'セルをループして黄色だったら、Sheet2へ転記
    For i = 1 To LastRow
        If Sh1.Cells(i, 1).Interior.Color = 65535 Then
            Sh1.Cells(i, 1).Copy Sh2.Cells(j, 1)
            j = j + 1
        End If
    Next i
    
    Set Sh1 = Nothing
    Set Sh2 = Nothing
            
End Sub

マクロ実行前

「Sheet1」シートにデータが入力してあり、色付きセルが存在しています。


 

マクロ実行後

「Sheet1」シートの A列に色がついているセルのみ抽出し、別シートに転記します。


 

色付きセルを別シートに抽出(複数列)

以下のマクロを実行すると、色のついたセルを別シートへ転記します。


Sub 色がついているセルを別のシートへ転記()

Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim i As Long
Dim j As Long
Dim Q As Long

    Q = 2
    
    Set Sh1 = Sheets("Sheet1")
    Set Sh2 = Sheets("Sheet2")
    
    'セルをループして黄色だったら、Sheet2へ転記
    For j = 1 To 3
        For i = 1 To 16
            If Sh1.Cells(i, j).Interior.Color = 65535 Then
                Sh1.Cells(i, j).Copy Sh2.Cells(Q, 1)
                Q = Q + 1
            End If
        Next i
    Next j
    
    Set Sh1 = Nothing
    Set Sh2 = Nothing
            
End Sub

マクロ実行前

「Sheet1」シートに複数列のデータが入力してあり、色付きセルがあります。

 

マクロ実行後

「Sheet1」シートの A~C列に色がついているセルのみ抽出し、別シートに転記します。


 
 
この記事がお役に立ちますと幸いです。
 
・【エクセルマクロ】別シート転記を自動処理する方法まとめ
 

【エクセルマクロ】別シート転記(抽出)を自動化する:超便利20選
...

 

「プログラマーの本気がExcelを覚醒させる 超絶ExcelVBA」
ExcelVBAでワンランクアップできる書籍
具体的で応用が利く技をたくさん掲載