合并多个工作表到新工作表中

将多个工作表中的内容合并到一个工作表的B列之后,并且A列为表名

完整程序

Sub HeBing()
Dim CProw
Dim Endrow
Dim i
Dim n


Application.ScreenUpdating = False


For i = 1 To Sheets.Count
    Endrow = Range("A2000").End(xlUp).Row
    CProw = Sheets(i).Range("A2").End(xlDown).Row
    n = Sheets(i).Name
    
    If Sheets(i).Name <> ActiveSheet.Name Then
    Sheets(i).Range("A2", "D" & CProw).Copy Cells(Endrow + CProw, 2)
    Range("A" & (Endrow + CProw), "A" & (Endrow + CProw + CProw)).Value = n
    End If
Next i
Range("B1").Select
Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True


End Sub

解释

Endrow =  Range("A2000").End(xlUp).Row

定义活动工作表的A列最后一个非空白行,行数
Range("A2000") : 表格A列2000行
End(xlUp): ctrl + ↑

No.AB
1123
2234
3345Endrow
...
2000row A2000
CProw = Sheets(i).Range("A2").End(xlDown).Row

CProw : 其他工作表的内容复制的行数
Sheet(i).Range("A2"): 选定sheet(i) [指非当前活动工作表] 的A列2行
End(xlDown).row: ctrl + ↓

Sheets(i).Range("A2", "D" & CProw).Copy Cells(Endrow + CProw, 2)

Sheet(i) 工作表A2到D[CProw] 区域的内容 复制到 活动工作表 [Endrow+ CProw] 行,B列
range("a1","d5"): (X --选定区域)

ABCD
XXXX
XXXX
XXXX
XXXX
XXXX

Cells( "row num", "column num") or Cells(1,"B") B列1行

Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

以B列为判定条件,删除空白行

转载于:https://www.cnblogs.com/jenneyforis/p/11589419.html

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值