きー

Sub JoinSheets()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long, lastRow3 As Long
    Dim i As Long, j As Long, k As Long
    Dim key1 As String, key2 As String
    
    ' シートを取得
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws3 = ThisWorkbook.Sheets("Sheet3")
    
    ' シート1の最終行を取得
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    
    ' シート3にシート1のヘッダーを貼り付け
    For i = 1 To ws1.Columns.Count
        ws3.Cells(1, i).Value = ws1.Cells(1, i).Value
    Next i
    
    ' シート1とシート2を結合してシート3に貼り付け
    k = 2 ' シート3の行数
    For i = 2 To lastRow1
        key1 = ws1.Cells(i, "A").Value ' シート1のキー
        lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row ' シート2の最終行
        For j = 2 To lastRow2
            key2 = ws2.Cells(j, "A").Value ' シート2のキー
            If key1 = key2 Then ' キーが一致する場合は結合してシート3に貼り付け
                For k = 2 To ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row
                Next k
                For k = 1 To ws1.Columns.Count
                    ws3.Cells(k, ws3.Cells(1, ws3.Columns.Count).End(xlToLeft).Column + 1).Value = ws1.Cells(i, k).Value
                Next k
                For k = 2 To ws2.Columns.Count
                    ws3.Cells(k, ws3.Cells(1, ws3.Columns.Count).End(xlToLeft).Column + 1).Value = ws2.Cells(j, k).Value
                Next k
            End If
        Next j
    Next i
End Sub