|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本人想要合并一个文件夹下的多个excel表格,表格的名字无规律,有xlsx和xls两种格式,每个表格有多个sheet,sheet的名字不同,但顺序相同,表头相同。
合并成为一个新的多sheet的表格,每个sheet把数据汇总就可以。
由于本人刚接触VBA,也没有代码基础,暂时将这个需求分为3段:
1.打开文件夹下所有表格
2.创建一个新的汇总表,添加sheet并修改名字,给每个sheet添加表头
3.除VBA所在表格和新建汇总表外,将打开的表格的每个sheet中第二行开始复制到新建汇总表对应的sheet A列最后一个空的单元格
由于接触时间短,逻辑比较混乱,参考书上的一些写法,前两段可以运行,第三段不能运行,麻烦各位大神帮忙看看
或者各位是否写过类似vba可以供我参考,十分感谢!
Sub 打开文件夹下所有xlsx表格()
Application.ScreenUpdating = False
Dim myPath As String, myFile As String, wb As Workbook '打开文件夹下所有xlsx格式的文件
myPath = ThisWorkbook.Path
myFile = Dir(myPath & "\*.xlsx")
Do While myFile <> "" '
If myFile <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(myPath & "\" & myFile)
End If
myFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Sub 新建汇总表格()
Application.DisplayAlerts = False
Dim wb As Workbook, sht As Worksheet, i As Long '新建workbook改名,worksheet改名,加表头
Set wb = Workbooks.Add
i = 1
For i = 1 To Month(Date) - 2 Step 1
Set sht = Worksheets(i)
sht.Name = "订单上报日期" & i + 2 & "月"
sht.Range("a1:t1") = Array("订单号", "订单上报日期", "ASC代码", "ASC名称", "ASC收货人", "ASC收货人手机号", "ASC收货地址", "零件号", "供应商", "零件名称", "订购数量", "发货数量", "快递单号", "快递公司名称", "发货时间", "预计发货时间", "签收日期", "实际签收人", "实际签收人联系方式", "备注")
Worksheets.Add after:=Worksheets(i)
Next
Worksheets(i).Delete '删掉多余的最后一个sheet
wb.SaveAs FileName:=ThisWorkbook.Path & "\DD精品跟踪单-" & Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日" & ".xlsx"
Application.DisplayAlerts = True
End Sub
Sub 合并内容()
Dim wb As Workbook, sht As Worksheet, r As Long, c As Long, i As Long, rng As Range, myPath As String, myFile As String
myPath = ThisWorkbook.Path
myFile = Dir(myPath & "*.xlsx")
Do While myFile <> "" '循环至表格名字为空
If myFile <> ThisWorkbook.Name And "DD精品跟踪单-" & Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日" & ".xlsx" Then '判断表格不是VBA表格和汇总表
For i = 1 To sheetcount '对于表格内每个sheet进行操作
rng = Worksheets(i).Range("a2").CurrentRegion.Select '选择填了信息单元格区域
r = Rows("rng")
c = Columns("rng")
rng = Range(Cells(2, 1), Cells(r, c)).Select '通过选择A2至最后一个单元格去表头赋值给rng
Range(rng).Copy Workbooks("DD精品跟踪单-" & Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日" & ".xlsx").Worksheets(i).Range("a108597").End(xlUp)
'复制rng至汇总表A列最后一个空格
Next
End If
Loop
End Sub
|
|