■

'シートのデータを複数シートに反映
Private Sub 共通()
    Dim common_s As Worksheet
    Dim common_data As Variant
    Dim loop_colCnt As Integer
    Dim table_names As Object
    Dim loop_rowCnt As Integer
    Dim write_s As Worksheet
    Dim write_colData As Variant
    Dim loop_wCnt As Integer
    Dim loop_outCnt As Long
    Dim out_data() As String
    
    Set table_names = CreateObject("Scripting.Dictionary")
    Set common_s = ThisWorkbook.Sheets("共通")
    
    '★
    common_data = common_s.Range("D7:G9")
    
    common_data = common_data
    
    '列部分取得
    For loop_colCnt = LBound(common_data, 2) To UBound(common_data, 2)
        If common_data(1, loop_colCnt) <> "" Then
            table_names.Add loop_colCnt, common_data(1, loop_colCnt)
        End If
    Next loop_colCnt
    
    'メイン処理
    For loop_rowCnt = 2 To UBound(common_data)
        For loop_colCnt = 3 To UBound(common_data, 2)
            If common_data(loop_rowCnt, loop_colCnt) = "〇" Then
                Set write_s = ThisWorkbook.Worksheets(table_names(loop_colCnt))
                
                '★列数を取得、格納
                write_colData = write_s.Range("A2:B2")
                
                For loop_wCnt = LBound(write_colData, 2) To UBound(write_colData, 2)
                    '列名を比較
                    If write_colData(1, loop_wCnt) = common_data(loop_rowCnt, 1) Then
                        '★行数分一括でデータセット
                        For loop_outCnt = 0 To 0
                            ReDim Preserve out_data(loop_outCnt) As String
                            '値を取得
                            out_data(loop_outCnt) = common_data(loop_rowCnt, 2)
                        Next
                        '★
                        write_s.Range(write_s.Cells(3, loop_wCnt).Address & ":" & write_s.Cells(3, loop_wCnt).Address) = out_data
                    End If
                Next
            End If
        Next loop_colCnt
    Next loop_rowCnt
End Sub