Sub test() Dim s, t Dim i As Integer Dim rs As Integer s = Array(1, 5, 8) t = Array(2, 6, 7) Sheets("目标表").Select With Sheets("原始表") For i = 0 To UBound(s) rs = .Cells(65536, s(i)).End(xlUp).Row - 1 Cells(65536, t(i)).End(xlUp).Offset(1, 0).Resize(rs, 1).Value = .Cells(2, s(i)).Resize(rs, 1).Value Next End With End Sub