ばくがの業務効率化チャンネル

このブログは個人的なエクセルの備忘録です

別シートから列ごとコピー

Sub データをコピー()
    Dim シート1 As Worksheet, シート2 As Worksheet
    Dim 対象値 As Variant
    Dim 範囲 As Range, セル As Range
    Dim コピー範囲 As Range
    
    ' シートを指定
    Set シート1 = ThisWorkbook.Sheets("Sheet1")
    Set シート2 = ThisWorkbook.Sheets("Sheet2")
    
    ' シート1のL37の値を取得
    対象値 = シート1.Range("L37").Value
    
    ' シート2のA1, B1, C1, E1のセルで同じ値があるかチェック
    Set 範囲 = シート2.Range("A1:B1:C1:E1")
    
    For Each セル In 範囲
    
        If セル.Value = 対象値 Then
        
            ' 対象列の1行目から7行目までをコピー
            Set コピー範囲 = シート2.Range(セル.Offset(1, 0), セル.Offset(7, 0))
            
            コピー範囲.Copy シート1.Range("B30")
            
            Exit Sub
            
        End If
        
    Next セル
    
    ' 同じ値がない場合はエラーを表示
    シート1.Range("B30").Value = "エラー"
    
End Sub