【エクセルマクロ】複数の色つきセルを別シート抽出:コピペで使えるコード

ExcelVBA-複数の色付きセルを別シートに抽出-アイキャッチ エクセルマクロで効率化する

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

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

複数の色つきセルを別シート抽出

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


Sub 色のついたセルを別シート転記()

Dim KiroSh As Worksheet
Dim MidoriSh As Worksheet
Dim AoSh As Worksheet
Dim Sh1 As Worksheet
Dim LastRow As Long
Dim i As Long
Dim j As Long
    
    'シートを変数へ格納
    Set Sh1 = Sheets("Sheet1")
    Set KiroSh = Sheets("黄色")
    Set MidoriSh = Sheets("緑")
    Set AoSh = Sheets("青")
    
    '3列分ループ
    For j = 1 To 3
    
        '23行分ループ
        For i = 1 To 23
        
            With Sh1.Cells(i, j)
            
                '黄色だったら
                If .Interior.Color = 65535 Then
                    LastRow = KiroSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    .Copy KiroSh.Cells(LastRow, 1)
    
                '緑だったら
                ElseIf .Interior.Color = 5287936 Then
                    LastRow = MidoriSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    .Copy MidoriSh.Cells(LastRow, 1)
                    
                '青だったら
                ElseIf .Interior.Color = 15773696 Then
                    LastRow = AoSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    .Copy AoSh.Cells(LastRow, 1)
                                  
                End If
            
            End With
        Next i
    Next j
    
    Set Sh1 = Nothing
    Set KiroSh = Nothing
    Set MidoriSh = Nothing
    Set AoSh = Nothing
    
End Sub

 

マクロ実行前

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

 

マクロ実行後

「Sheet1」シートから色がついているセルのみ抽出し、指定シートに転記します。


 
 
この記事がお役に立ちますと幸いです。
 

【エクセルマクロ】色付け処理を自動化する:超便利22選
...

 

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