可以先将其中之一链接到你想到的文件,并将这个单位格复制。
然后用CTRL+F,全部查找A,按CTRL+A,这样选中所有的A,直接粘贴就0K。
Sub M_自动分表()
Dim a, b As Worksheet
aa = "" & Cells(1, 3).Value
Set a = Worksheets(aa)
Set b = Worksheets("汇总")
M_删除分表
For i = 3 To b.Range("A65536").End(xlUp).Row
If b.Cells(i, 1).Value = aa Then
y = a.Range("A65536").End(xlUp).Row + 1
a.Cells(y, 1).Value = Cells(i, 1).Value
a.Cells(y, 2).Value = Cells(i, 2).Value
a.Cells(y, 3).Value = Cells(i, 3).Value
a.Cells(y, 4).Value = Cells(i, 4).Value
a.Cells(y, 5).Value = Cells(i, 5).Value
'a.Cells(y, 6).Value = Cells(i, 2).Value
a.Cells(y, 7).Value = Cells(i, 7).Value
a.Cells(y, 8).Value = Cells(i, 8).Value
a.Cells(y, 9).Value = Cells(i, 9).Value
'a.Cells(y, 10).Value = Cells(i, 2).Value
a.Cells(y, 11).Value = Cells(i, 11).Value
a.Cells(y, 12).Value = Cells(i, 12).Value
a.Cells(y, 13).Value = Cells(i, 13).Value
a.Cells(y, 14).Value = Cells(i, 14).Value
'a.Cells(y, 15).Value = Cells(i, 3).Value
'a.Cells(y, 16).Value = Cells(i, 4).Value
'a.Cells(y, 17).Value = Cells(i, 1).Value
a.Cells(y, 18).Value = Cells(i, 18).Value
'a.Cells(y, 19).Value = Cells(i, 3).Value
a.Cells(y, 20).Value = Cells(i, 20).Value
End If
Next i
End Sub
Sub M_删除分表()
Dim a, b As Worksheet
aa = "" & Cells(1, 3).Value
Set a = Worksheets(aa)
For y = 2 To a.Range("A65536").End(xlUp).Row
a.Cells(y, 1).Value = ""
a.Cells(y, 2).Value = ""
a.Cells(y, 3).Value = ""
a.Cells(y, 4).Value = ""
a.Cells(y, 5).Value = ""
'a.Cells(y, 6).Value = Cells(i, 2).Value
a.Cells(y, 7).Value = ""
a.Cells(y, 8).Value = ""
a.Cells(y, 9).Value = ""
'a.Cells(y, 10).Value = Cells(i, 2).Value
a.Cells(y, 11).Value = ""
a.Cells(y, 12).Value = ""
a.Cells(y, 13).Value = ""
a.Cells(y, 14).Value = ""
'a.Cells(y, 15).Value = Cells(i, 3).Value
'a.Cells(y, 16).Value = Cells(i, 4).Value
'a.Cells(y, 17).Value = Cells(i, 1).Value
a.Cells(y, 18).Value = ""
'a.Cells(y, 19).Value = Cells(i, 3).Value
a.Cells(y, 20).Value = ""
Next y
End Sub