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

将多个工作表中的内容合并到一个工作表的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 + ↑

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 --选定区域)

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