>>222ですがコピペ記述できました助言ありがとうございました

Sub

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim name As String
Dim r As Variant

　　Set ws1 = Worksheets("シート1")
　　Set ws2 = Worksheets("シート2")
　　name = Worksheets("シート2").Range("*").Value
　　r = Application.WorksheetFunction.Match(name, Worksheets("シート1").Columns("a"), 0)
　　
　　Application.ScreenUpdating = False

　　ws1.Activate
　　ws1.Cells(r, 4).Select
　　Selection.Resize(1,6).Select
　　Selection.Copy
　　ws2.Range("a6:a11").PasteSpecial (xlPasteValues)

　　Application.ScreenUpdating = True

End Sub

シート切り替え時の画面ちらつきを消すために見よう見まねでScreenUpdatingを入れました
期待通りの動きをしてくれてますがもっと上手い記述を参考程度に教えていただきたいです

VLOOKUPだと直接セルに入力する場合があってその時困るのでVBAでやってみようと思った次第です
ACCESSは諸事情で使えません