Sub 汇总()
  
    Rows("4:10000").Clear '清除汇总表标题行以下数据
    
    Application.Wait Now + TimeValue("00:00:01") '延迟1秒
    
    Dim st As Worksheet, rng As Range, rrow As Integer, i As Integer '定义相关变量
    
    For i = 4 To Worksheets.Count '遍历循环工作簿下表格,从第4个表开始
    
        Set st = Sheets(i)
        
        Set rng = Range("A10000").End(xlUp).Offset(1, 0) '判断汇总表中首个非空表格位置

        rrow = st.Range("A4").CurrentRegion.Rows.Count - 1 '判断表格需要复制的区域

        st.Range("A4").Resize(rrow, 12).Copy rng '将明细表复制到汇总表中
        
    Next i

    MsgBox ("汇总完成")

End Sub
Xian'ser 博客交流QQ:1550356869
老薛主机优惠码【xianser】15%,可开香港/美国等机房,【点击抢购
Last modification:April 6th, 2022 at 09:39 am
If you think my article is useful to you, please feel free to appreciate