多个sheet表合并的问题

釜底抽薪

表头跟表尾处理 的不是很好 哥哥们帮小弟修改下，详细看附件 看图片 只要一个表头，表头有4行吗，结果出来一行 不合并表尾
代码入下
Sub 多表合并3()
    Dim RMax As Integer, CMax As Integer
    Dim Sht As Worksheet, ShtR As Integer
   
    For Each Sht In Worksheets
        If Sht.Name <> "汇总" Then
            With Sht.Range("A4")                                   '设定为每个表的A4单元开始操作
                ShtR = Sheets("汇总").UsedRange.Rows.Count         '统计汇总表中是不是未使用，如果是空白就返回1
                RMax = .End(4).Row - 1                             '获取每个表格最大行，4从开始向下，3为最大行向上去行
                CMax = .End(2).Column                              '获取每个表格最大列，2从开始向右，1为最大行向左取列
                Rem                                                 如果汇总为空格，就复制开始表格第一行到汇总表的第一行
                If ShtR = 1 Then .EntireRow.Copy Sheets("汇总").Cells(ShtR)
                Rem                                                 从每个表格的A1单元格开始复制之指定的行列范围到汇总表的对应最大行+1
                .Offset(1).Resize(RMax, CMax).Copy Sheets("汇总").Cells(ShtR + 1, 1)
            End With
        End If
    Next Sht
       Rows.SpecialCells(xlCellTypeBlanks).Select                   '选取空的行
       Selection.EntireRow.Delete                                   '选择的整行删除
    Rem  下句代码 自动调整列宽
    Sheets("汇总").Cells.EntireColumn.AutoFit
End Sub

高

Sub 多表合并3()
    Dim RMax As Integer, CMax As Integer
    Dim Sht As Worksheet, ShtR As Integer
   
    For Each Sht In Worksheets
        If Sht.Name <> "汇总" Then
            With Sht.Range("A4")                                   '设定为每个表的A1单元开始操作
                ShtR = Sheets("汇总").UsedRange.Rows.Count         '统计汇总表中是不是未使用，如果是空白就返回1
               
                RMax = .End(4).Row - 1                             '获取每个表格最大行，4从开始向下，3为最大行向上去行
                If Not Sht.Range("a" & RMax + 1) Like "*" & "制表人" & "*" Then
                RMax = RMax + 1
                End If
                CMax = .End(2).Column                              '获取每个表格最大列，2从开始向右，1为最大行向左取列
                Rem                                                 如果汇总为空格，就复制开始表格第一行到汇总表的第一行
                If ShtR = 1 Then .EntireRow.Copy Sheets("汇总").Cells(ShtR)
                Rem                                                 从每个表格的A1单元格开始复制之指定的行列范围到汇总表的对应最大行+1
                .Offset(1).Resize(RMax - 4, CMax).Copy Sheets("汇总").Cells(ShtR + 1, 1)
            End With
        End If
    Next Sht
'       Rows.SpecialCells(xlCellTypeBlanks).Select                   '选取空的行
'       Selection.EntireRow.Delete                                   '选择的整行删除
    Rem  下句代码 自动调整列宽
    Sheets("汇总").Cells.EntireColumn.AutoFit
End Sub

不需要定位空行。并且你那么定位也不对

高

主要改了两处，一是RMax，如果A列RMax+1这个单元格不包含“制表人”，RMax要等于RMax+1
二是， .Offset(1).Resize(RMax - 4, CMax).Copy Sheets("汇总").Cells(ShtR + 1, 1)  这里要减去4

釜底抽薪

高 发表于 2019-2-14 16:14
主要改了两处，一是RMax，如果A列RMax+1这个单元格不包含“制表人”，RMax要等于RMax+1
二是， .Offset(1) ...

非常感谢你的指点，我还在学习 入门当中，我在慢慢消化