如何实现将固定SHEET的内容在不同SHEET的数据进行自动统计？

徐建辉

麻烦请教一下大师们，如何能实现将固定SHEET 1中修改的内容， 在不同 SHEET 2 中进行数据的自动统计？
固定格式的SHEET 1 是需要打印出来的，所以填入所需内容后就需要清除掉，填入其他新的内容。
填好的内容希望直接在另外的 SHEET 2 中进行增加汇总。 以前见过别人用过类似的表格，应该是用了 宏 或者 数据库什么的。
做了一个类似增加按钮的东西，一点那个按钮SHHET 2 里面就自动增加内容了。
实在不知道应该怎么做，还请大师们指教，谢谢！
工作簿1.rar (11.21 KB, 下载次数: 14)

2021-10-17 18:43 上传

点击文件名下载附件
工作簿1.rar

司徒云天

Sub 增加汇总()
  Dim EndRow As Byte, EndCol As Byte, DataArr() As Variant, ToRng As Range, ArrI As Byte
  With ActiveSheet
  EndRow = .Range("B6").End(xlDown).Row
  EndCol = .Range("B6").CurrentRegion.Columns.Count + 1
  DataArr = .Range(.Cells(7, 2), .Cells(EndRow, EndCol)).Value
  ReDim Preserve DataArr(1 To UBound(DataArr, 1), 1 To UBound(DataArr, 2) + 1)
  For ArrI = 1 To UBound(DataArr, 1)
    DataArr(ArrI, UBound(DataArr, 2)) = [C18]
    Worksheets(2).Range("B" & ArrI + Worksheets(2).Range("F2").End(xlDown).Row) = [C3]
    Worksheets(2).Range("C" & ArrI + Worksheets(2).Range("F2").End(xlDown).Row) = [C4]
    Worksheets(2).Range("D" & ArrI + Worksheets(2).Range("F2").End(xlDown).Row) = [H3]
    Worksheets(2).Range("E" & ArrI + Worksheets(2).Range("F2").End(xlDown).Row) = [H4]
  Next ArrI
  Set ToRng = Worksheets(2).Range("F1048576").End(xlUp).Offset(1, 0)
  ToRng.Resize(UBound(DataArr, 1), UBound(DataArr, 2)) = DataArr
  End With
End Sub
工作簿1.zip

痞气书生

limonet非常感谢你！要的就是这样的效果， 前几天一直出差，忘记回复表示感谢了！我自己先研究学习一下，不明白的地方还需要请教！谢谢！

茗香

不好意思，还希望请教一下。格式稍微做了调整以后，就没有这个效果了。
自己调整了半天也没有成功。 实在搞不定了，麻烦大神帮忙看一下该如何调整，谢谢了！
工作簿1.zip (22.97 KB, 下载次数: 10)

2021-10-17 18:43 上传

点击文件名下载附件
工作簿1.zip

啥都不想了

Sub 增加汇总()
  Dim EndRow As Byte, EndCol As Byte, DataArr() As Variant, ToRng As Range, ArrI As Byte
  Set ToRng = Worksheets(2).Range("E1048576").End(xlUp).Offset(1, 1)
  With ActiveSheet
  EndRow = .Range("B11").End(xlDown).Row
  EndCol = .Range("B11").CurrentRegion.Columns.Count + 1
  DataArr = .Range(.Cells(12, 2), .Cells(EndRow, EndCol)).Value
  ReDim Preserve DataArr(1 To UBound(DataArr, 1), 1 To UBound(DataArr, 2) + 1)
  For ArrI = 1 To UBound(DataArr, 1)
    DataArr(ArrI, UBound(DataArr, 2)) = [C23]
    Worksheets(2).Range("B" & ArrI + Worksheets(2).Range("F2").End(xlDown).Row) = [C4]
    Worksheets(2).Range("C" & ArrI + Worksheets(2).Range("F2").End(xlDown).Row) = [C5]
    Worksheets(2).Range("D" & ArrI + Worksheets(2).Range("F2").End(xlDown).Row) = [H4]
    Worksheets(2).Range("E" & ArrI + Worksheets(2).Range("F2").End(xlDown).Row) = [H5]
  Next ArrI
  ToRng.Resize(UBound(DataArr, 1), UBound(DataArr, 2)) = DataArr
  End With
End Sub
工作簿1.zip (22.82 KB, 下载次数: 11)

2021-10-17 18:43 上传

点击文件名下载附件
工作簿1.zip

再板你一砖

感谢分享！ 可以使用了，我自己再学习一下，要不格式动了就又不行了！ 谢谢你呢！