vba学习系列(7)--考勤表制作

系列文章目录

前言

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

Sub CopyRangesToSummary()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim summarySheetName As String
    
    summarySheetName = "考核汇总"
    
    ' 确保摘要工作表存在
    On Error Resume Next
    Set targetSheet = ThisWorkbook.Worksheets(summarySheetName)
    If Err.Number <> 0 Then
        ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).Name = summarySheetName
        Set targetSheet = ThisWorkbook.Worksheets(summarySheetName)
    End If
    On Error GoTo 0
    
     targetSheet.Rows("7:1001").Delete
    
    ' 遍历所有工作表
    For Each sourceSheet In ThisWorkbook.Worksheets
        If 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 = False
        End If
    Next sourceSheet
    
    Range("A2:AK6").Select
    Selection.Copy
    Sheets("考核汇总").Select
    ActiveWindow.SmallScroll Down:=-3
    Range("A7:AK1001").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    
End Sub

二、汇总所有工作表指定区域内容到指定工作表(带公式)

Sub CopyMultipleSheetsToSingle()
    Dim ws As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim copyRange As Range
    
    ' 指定目标工作表
    Set targetSheet = ThisWorkbook.Worksheets("考核汇总") ' 修改为目标工作表名称
    
    targetSheet.Rows("2:1000").Delete
    
    ' 遍历工作簿中的所有工作表
    For Each ws In ThisWorkbook.Worksheets
        If 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 If
    Next ws
End Sub

附件：
https://download.csdn.net/download/qq_45365214/89865531

总结

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