因为是VBA 新手，程序是自己编的，有一些明显不完善的地方，就拿出来和大家分享交流学习吧。

觉得还能看，大家就多多回复捧场就好

程序说明：

现有600xxx-600xxx的两个文件夹的文件。文件夹一中，文件名为“现任管理层[600xxx.SH].xls"，文件二中为”离任高管[600xxx.SH].xls"

现希望：

1 将现任管理层的表格中A列前添加一列并填写“现任管理层”字样，添加一列输入股票代码；离任高管的表格中类同

2 批量汇总上述两个文件夹中修改后的内容到一个表格内

缺点：

文件命名需要有规律，此处为数字的递增规律，同时，因为有断点所以数字不连续的地方需要分开进行两次程序操作。

有好的地方的话大家可以借鉴，可以改进的地方望各位不吝赐教，多谢！

Public Sub huizong()

t =1

Range("a1").Select

Fori = 600350 To 600590

d1 ="D:\常使用文件\Documents\Downloads\现任管理层[" & Str(i) & ".SH].xls"

arr1= Split(d1, " ")

  d =arr1(0) & arr1(1)

Workbooks.Open d

  a1= "D:\常使用文件\Documents\Downloads\离任高管[" & Str(i) & ".SH].xls"

arr2 = Split(a1, " ")

  a =arr2(0) & arr2(1)

  e1= "现任管理层[" & Str(i) & ".SH].xls"

arr3 = Split(e1, " ")

  e =arr3(0) & arr3(1)

  b1= "离任高管[" & Str(i) & ".SH].xls"

arr4 = Split(b1, " ")

  b =arr4(0) & arr4(1)

Workbooks(e).Activate   '选定现任表格

Range("A5").Select

Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove

Range("B5").Select

Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove  '插入两列

j =4

   DoWhile (Cells(j + 2, 5) Like "*" & "/" &"*") Or (Cells(j + 1, 5) Like "*" & "/" &"*") Or (Cells(j, 5) Like "*" & "/" &"*") Or (Cells(j + 3, 5) Like "*" & "/" &"*")

  Cells(j, 1) = Str(i)

  Cells(j, 2) = "现任"

   j= j + 1

  Loop

    s = j - 1   '以上为填充两列，s为需要粘贴的行数

    Cells(t, 1).Select

    Range(Cells(1, 1), Cells(s, 10)).Select

    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

    Selection.Copy

    Workbooks("汇总表.xlsm").Activate

    ActiveSheet.Paste

    t = t + s

    Cells(t, 1).Select

   c1 = "现任管理层[" & Str(i) & ".SH].xls"

   arr5 = Split(c1, " ")

    c= arr5(0) & arr5(1)

   Application.CutCopyMode = xlCut

   Workbooks(c).Close savechanges = True         '关闭已经打开的工作簿

   Cells(t,1).Select

  Workbooks.Open a         '选定离任表格

Workbooks(b).Activate

   Range("A5").Select

Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove

Range("B5").Select

Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove   '插入两列

k = 2

   DoWhile (Cells(k + 1, 5) Like "*" & "-" &"*") Or (Cells(k, 5) Like "*" & "-" &"*")

  Cells(k, 1) = Str(i)

  Cells(k, 2) = "离任"

   k= k + 1

  Loop

   u= k - 1           '以上为填充两列，u为需要粘贴的行数

  Range(Cells(1, 1), Cells(u, 11)).Select

   Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

   Selection.Copy

   Workbooks("汇总表.xlsm").Activate

   ActiveSheet.Paste

    t= t + u

   g1 = "离任高管[" & Str(i) & ".SH].xls"

   arr6 = Split(g1, " ")

    g= arr6(0) & arr6(1)

   Application.CutCopyMode = xlCut

   Workbooks(g).Close savechanges = True         '关闭已经打开的工作簿

   Cells(t + 1, 1).Select

Next

End Sub