南京网站建设网合肥网站建设程序

系列文章目录

前言

一、汇总所有工作表指定区域内容到指定工作表

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

总结

分享：
负郭幽居一林清，残花寂寂水泠泠，夜深宴坐无灯火，卷土疏帘月满庭；