|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 sxo 于 2022-12-8 15:03 编辑
- Sub 合并工表()
- Application.ScreenUpdating = False
- Dim filename As String, sht As Worksheet, wb As Workbook, arr As Variant
- Dim endrow As Long, tosht As Worksheet, torng As Range
- Set tosht = ThisWorkbook.Worksheets(1)
- Set torng = tosht.Range("A1048576").End(xlUp).Offset(1, 0)
- filename = Dir("D:\1\*.xls?")
- Do While filename <> ""
- Workbooks.Open filename:="D:\1" & filename
- Set wb = ActiveWorkbook
- Set sht = wb.Worksheets(1)
- endrow = sht.Range("A1048576").End(3).Row
- arr = sht.Range("A1").Resize(endrow - 1, 9).Value
- wb.Close savechanges:=False
- torng.Resize(UBound(arr, 1), 9).NumberFormatLocal = "@"
- torng.Resize(UBound(arr, 1), 9).Value = arr
- torng.Resize(UBound(arr, 1), 9).EntireColumn.AutoFit
- filename = Dir
- Loop
- Application.ScreenUpdating = True
- End Sub
复制代码
|
|