| 
    
     |  | ▼初心者です。 さん: 
 コピペを繰り返すほうが、簡単でしたね。
 
 Sub test2()
 Dim wsFrom As Worksheet, wsTo As Worksheet
 Dim rngFrom As Range, rngTo As Range
 Dim c As Range
 Dim m
 
 Set wsFrom = Worksheets("A")
 Set rngFrom = wsFrom.Cells(1).CurrentRegion
 Set rngFrom = Intersect(rngFrom, rngFrom.Offset(1))
 
 
 Set wsTo = Worksheets("B")
 wsTo.UsedRange.Offset(1).ClearContents
 Set rngTo = wsTo.Cells(1).CurrentRegion
 
 For Each c In rngTo
 m = Application.XMatch(c, rngFrom.Rows(0))
 If IsNumeric(m) Then
 rngFrom.Columns(m).Copy
 c.Offset(1).PasteSpecial xlPasteValues
 End If
 Next
 Application.CutCopyMode = False
 
 rngTo.CurrentRegion.Columns(1).SpecialCells(xlCellTypeBlanks).Value _
 = Application.Sequence(rngFrom.Rows.Count)
 
 End Sub
 
 |  |