下面的代码就可以了：

Option ExplicitOption Base 1 Sub xxx() Dim i, j Dim No No = Array("一", "二", "三", "四", "五", "六", "七", "八") For j = 1 To 4 '列1~4 For i = 1 To 4 '工作表1~4 '工作簿一的表i（1-4）的列2j（2、4、6、8）复制 到 工作簿二表4+j（5-8）的列i+1（2-5） Workbooks("一").Sheets(No(i)).Columns(j * 2).Copy Workbooks("二").Sheets(No(4 + j)).Columns(i + 1) Next i Next jEnd Sub编程的核心就是那个注释语句，总共进行16个列的复制：工作簿一的表i（1-4）的列2j（2、4、6、8）复制到工作簿二表4+j（5-8）的列i+1（2-5）附件是修改正确的“一.xls”