excel不同文件表格批量加表头vba_怎样批量自动添加表头

请见Sheet2

代码中的"户主"若变乱码，请自行修改

Sub test()

Dim r%, n%, c As Range, Sh As Worksheet

Set Sh = Sheets("Sheet2")

r = Sh.[A65536].End(xlUp).Row

With Sh.Range("A1:A" & r)

Set c = .Find("户主", , , 1)    '查找字符串"户主"

If Not c Is Nothing Then

fAdd = c.Address

n = c.Row    '字符串"户主"所在列号

Do

If c.Row > n Then

If c.Row - n < 8 Then Sh.Rows(c.Row).Resize(8 - (c.Row - n)).Insert Shift:=xlDown    '每户不滿8列，插入空白列

Application.CutCopyMode = False

Sh.Range("A1:Q6").Copy    '复制表头

Sh.Rows(c.Row).Insert Shift:=xlDown    '插入表头

n = c.Row

End If

Set c = .FindNext(c)    '查找下个字符串"户主"所在列

Loop While Not c Is Nothing And c.Address <> fAdd

End If

Application.CutCopyMode = True

Sh.Range(Sh.Cells(n, 1), Sh.Cells(n + 7, 17)).Borders.LineStyle = 1    '最后一户不滿8列，画8列表格线

End With

End Sub

2010-7-1 08:49 上传

点击文件名下载附件

11.12 KB, 下载次数: 77