系列文章目录
文章目录
- 系列文章目录
- 前言
- 一、汇总所有工作表指定区域内容到指定工作表
- 二、汇总所有工作表指定区域内容到指定工作表(带公式)
- 总结
前言
一、汇总所有工作表指定区域内容到指定工作表
Sub CopyRangesToSummary()Dim sourceSheet As WorksheetDim targetSheet As WorksheetDim lastRow As LongDim summarySheetName As StringsummarySheetName = "考核汇总"' 确保摘要工作表存在On Error Resume NextSet targetSheet = ThisWorkbook.Worksheets(summarySheetName)If Err.Number <> 0 ThenThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).Name = summarySheetNameSet targetSheet = ThisWorkbook.Worksheets(summarySheetName)End IfOn Error GoTo 0targetSheet.Rows("7:1001").Delete' 遍历所有工作表For Each sourceSheet In ThisWorkbook.WorksheetsIf sourceSheet.Name <> summarySheetName Then' 找到目标工作表中的下一个空行lastRow = targetSheet.Cells(targetSheet.Rows.Count, "C").End(xlUp).Row' 复制范围(A1:R4)sourceSheet.Range("E2:AO6").Copy' 粘贴到摘要工作表中,紧接上一个工作表的数据后面targetSheet.Range("A" & lastRow + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats' 清除剪贴板Application.CutCopyMode = FalseEnd IfNext sourceSheetRange("A2:AK6").SelectSelection.CopySheets("考核汇总").SelectActiveWindow.SmallScroll Down:=-3Range("A7:AK1001").SelectSelection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _SkipBlanks:=False, Transpose:=FalseApplication.CutCopyMode = FalseEnd Sub
二、汇总所有工作表指定区域内容到指定工作表(带公式)
Sub CopyMultipleSheetsToSingle()Dim ws As WorksheetDim targetSheet As WorksheetDim lastRow As LongDim copyRange As Range' 指定目标工作表Set targetSheet = ThisWorkbook.Worksheets("考核汇总") ' 修改为目标工作表名称targetSheet.Rows("2:1000").Delete' 遍历工作簿中的所有工作表For Each ws In ThisWorkbook.WorksheetsIf ws.Index > 1 Then ' 跳过第一个工作表(假设第二个工作表是要开始复制的)Set copyRange = ws.Range("E2:AO6") ' 设置要复制的区域' 找到目标工作表中下一个空的行lastRow = targetSheet.Cells(targetSheet.Rows.Count, copyRange.Column).End(xlUp).Row' 将复制区域复制到目标工作表的下一个空行copyRange.Copy Destination:=targetSheet.Range("A" & lastRow + 1)End IfNext ws
End Sub
附件:
https://download.csdn.net/download/qq_45365214/89865531
总结
分享:
负郭幽居一林清,残花寂寂水泠泠,夜深宴坐无灯火,卷土疏帘月满庭;