Sub 问题() Dim r, num, arr, a, b, c, d r = Sheets(1).[a1].End(xlDown).row num = r - 1 Sheets(2).Select Range("a1:d5").Copy Range("a6:d" & num * 5).Select Sheets(2).Paste arr = Sheets(1).UsedRange c = 2 e = 2 Sheets(2).Select For a = 2 To r For b = 1 To 4 d = d + 1 Cells(c, 2).Offset(b - 1, 0) = arr(a, d) Next Cells(c, 2).Offset(0, 2) = arr(a, 5) Cells(c, 2).Offset(2, 2) = arr(a, 6) c = c + 5 d = 0 Next End Sub