>>454
Sub copipe()
Dim myPath As String, mybook As Variant, rs As Long
myPath = "Z:\"
mybook = Dir(myPath & "*.xlsx")
With Workbooks("aaa.xlsm").Worksheets("sheet1")
Do Until mybook = ""
Workbooks.Open (myPath & mybook)
rs = .Cells(.Cells.Rows.Count, "A").End(xlUp).Offset(2).Row
If rs = 3 Then
rs = 2
End If
.Cells(rs - 1, 1).Value = .Range("K1").Value
Workbooks(mybook).Worksheets("sheet1").Range("B2:j10").Copy .Cells(rs, 1)
Workbooks(mybook).Close
mybook = Dir()
Loop
.Range("A1:I100").ColumnWidth = ColumnWidth + 4
.Range("A1:I100").RowHeight = RowHeight + 28
End With
End Sub

1行開けのスペースの場所にある上級〜の文字はペーストするシートのK1に文字を入力したら同じ文字ばかりだけど入力される