Foxtable(狐表)用户栏目专家坐堂 → [求助]合并工作表,VBA问题


  共有2761人关注过本帖树形打印复制链接

主题:[求助]合并工作表,VBA问题

帅哥哟,离线,有人找我吗?
shenhq
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:幼狐 帖子:194 积分:1580 威望:0 精华:0 注册:2013/12/8 22:48:00
[求助]合并工作表,VBA问题  发帖心情 Post By:2019/8/29 13:04:00 [显示全部帖子]

有工作簿中有N个工作表,要将工作表中一定数据区域的数据合并至一张新表。
以下是VBA代码,运行到红字行后出错如下图:


图片点击可在新窗口打开查看此主题相关图片如下:sharedscreenshot1.jpg
图片点击可在新窗口打开查看

Sub 合并当前工作簿下的所有工作表()
    Dim arr As Variant, erow&, r&, c&, sht As Worksheet
    
    r = 14 '数据区域表头所在行号
    c = 7 '数据区域表头包含列数
    Application.ScreenUpdating = False
    
    Set sht = Sheets.Add(Type:=xlWorksheet) '生成一个新表(空合并表)
    Sheets(sht.Index).Move before:=Sheets(1) '将此表移动到第一个
    
For j = 2 To Worksheets.Count

            arr = Sheets(j).Range(Sheets(j).Cells(r + 1, 1), Sheets(j).Cells(65536, 1).End(xlUp).Offset(0, c - 1))  '将数据区域中的记录保存到数组arr中
            sht.Cells(erow, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr '将数组的值写入到合并表中
Next j
         With Range("A1").CurrentRegion.Font '汇总完成后,批量设置工作表的字体格式
            .Name = "微软雅黑"
            .Size = 11
            .Color = RGB(0, 0, 0)
         End With
         
Application.ScreenUpdating = True
MsgBox "当前工作簿下的全部工作表已经合并完毕!", vbInformation, "提示"

End Sub
-----------------------------------------------------------
请教各位大神,错误在哪?


[此贴子已经被作者于2019/8/29 13:05:22编辑过]

 回到顶部