VBA 江湖救急,多个EXCEL文件合并,如何除去第二到第N个表中每个SHEET的表头
多个格式相同的EXCEL文件合并(每个EXCEL都有多个SHEET),网上找了一代码,修改了下，但还需要进一步处理,可是我不会,所以来这请教高手们了。
1:我从第2到第N张表,表头内容就不复制了，但是下面关键代码有错，不知道怎么改,谢谢了。
Workbooks(dirname).Sheets(3).Range("A2", Cells.SpecialCells(xlCellTypeLastCell)).Copy _
Sheets(3).Range("a65536").End(xlUp).Offset(1, 0)
2:还有遍历EXCEL文件家所有SHEET,能不能写成循环呀.
不然
'复制新打开工作簿的第2个工作表的已用区域到当前工作表
Workbooks(dirname).Sheets(2).UsedRange.Copy _
Sheets(2).Range("a65536").End(xlUp).Offset(1, 0)
这段代码导致我有几个SHEET就要写几次,好麻烦呀.....
Sub UnionWorksheets()
大家如果有更好的函数,或者代码能实现多个EXCEL文件数据合并的,也可以贴出.
谢谢大家了。
Dim i As Long ' 循环变量
i = 0
Dim insert_row As Long ' 合并文件中的粘贴位置
Application.ScreenUpdating = False
Dim lj As String
Dim dirname As String
Dim nm As String
lj = ActiveWorkbook.Path
nm = ActiveWorkbook.Name
dirname = Dir(lj & "\*.xls")
Cells.Clear
Do While dirname <> ""
If dirname <> nm Then
i = i + 1
Workbooks.Open filename:=lj & "\" & dirname
Workbooks(nm).Activate
'复制新打开工作簿的第一个工作表的已用区域到当前工作表 '大哥们这个能不能写成循环,不然一个sheet来做一次好麻烦呀. Workbooks(dirname).Sheets(1).UsedRange.Copy _
Sheets(1).Range("a65536").End(xlUp).Offset(1, 0)
'复制新打开工作簿的第2个工作表的已用区域到当前工作表
Workbooks(dirname).Sheets(2).UsedRange.Copy _
Sheets(2).Range("a65536").End(xlUp).Offset(1, 0)
'复制新打开工作簿的第3个工作表的已用区域到当前工作表
If i = 1 Then
Workbooks(dirname).Sheets(3).UsedRange.Copy _
Sheets(3).Range("a65536").End(xlUp).Offset(1, 0)
Else '大哥们,我从第2到第N张表,表头内容就不复制了，但是下面代码有错，不知道怎么改,谢谢了。
Workbooks(dirname).Sheets(3).Range("A2", Cells.SpecialCells(xlCellTypeLastCell)).Copy _
Sheets(3).Range("a65536").End(xlUp).Offset(1, 0)
End If
Workbooks(dirname).Close False
End If
dirname = Dir
Loop
End Sub
[解决办法]
1.行尾咋有个下划线，貌似这两行代码不连着啊，去掉试试。
2.把sheet名改成包含数字标识的，如sheet1，sheet2……
这样就可以用变量i实现循环，sheet名为"sheet"&i。
[解决办法]
mark
[解决办法]
excel问题还是excelhome上人多
