excel - 将特定范围从多个工作表复制到单个工作表作为滚动报告
问题描述
这是我第一次提前这么抱歉。
我有一个包含几张纸的文件,我需要从 A14 复制到 I14 然后执行
Range(Selection, Selection.End(xlDown)).Select
为了捕获从原始范围到底部的所有数据,所有工作表都有不同的行数,这就是我需要这样做的原因。
选择数据后,我需要复制并粘贴到另一个名为“报告”的选项卡中,并且我需要为工作簿中的每个工作表执行此操作。
每次将工作表粘贴到“报告”选项卡中时,下一个工作表都需要进入“报告”选项卡的下一个avialbale 行,换句话说,我无法粘贴到最后一个信息之上。是滚动报告。
解决方案
Take this as base and adjust to your requirement. This program is Untested and may require adjustment for Header Rows. I have commented out Header Rows in program keeping in view you want to start from `Row1`
Sub CopyToReport()
Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Master Worksheet
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets
'Speed things up
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Working in active workbook
Set wrk = ActiveWorkbook
'Create/Reset the Report sheet
If Evaluate("ISREF(Report!A1)") Then
wrk.Sheets("Report").Move After:=Worksheets(Worksheets.Count)
wrk.Sheets("Report").Cells.Clear
Else
wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)).Name = "Report"
End If
Set trg = wrk.Sheets("Report")
'Get column headers from the first worksheet
'Column count first
Set sht = wrk.Worksheets(1)
' colCount = sht.Cells(1, Columns.Count).End(xlToLeft).Column
colCount =9
'Now retrieve headers, no copy&paste needed
'With trg.Cells(1, 1).Resize(1, colCount)
' .Value = sht.Cells(1, 1).Resize(1, colCount).Value
' 'Set font as bold
' .Font.Bold = True
'End With
'We can start loop
For Each sht In wrk.Worksheets
'Execute on every sheet except the Master
If sht.Name <> "Master" Then
'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
'Set rng = sht.Range(sht.Cells(1, 1), sht.Cells(Rows.Count, colCount).End(xlUp))
Set rng = sht.Range("A1:I14")
'Put data into the Master worksheet
trg.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End If
Next sht
'Fit the columns in Master worksheet
trg.Columns.AutoFit
'Screen updating should be activated
Application.ScreenUpdating = True
End Sub
推荐阅读
- django - 无法更新更新UpdateAPIView django rest中的反向关系字段
- java - OpenID Connect 的 Spring Security 5 XML 配置
- amadeus - 艾玛迪斯航班低价搜索 - 机场坐标
- objective-c - 如何将原生 ios 模块导入反应原生项目
- json - 无法使用 Circe JSON 解析器通过 JSON 字符串创建对象
- r - 关于在 huxtable 中设置列宽的困惑
- java - 数据库中的JPA外键,项目中的返回对象
- python - SQLAlchemy - 使用 user_id 初始化角色
- spss - 在 SPSS 中使用左连接合并两个数据集
- postgresql - 无法使用 jpa 和 hibernate 在 Postgres 中创建表