VBA -根据字段在不同表中出现的次数，多次复制一行

Sub DuplicateRows()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim lastRow As Long
    Dim i As Long
    Dim count As Long
    
    ' 设置源表和目标表
    Set sourceSheet = ThisWorkbook.Worksheets("源表")
    Set targetSheet = ThisWorkbook.Worksheets("目标表")
    
    ' 设置源表中字段所在的范围
    Set sourceRange = sourceSheet.Range("A1:A" & sourceSheet.Cells(Rows.Count, 1).End(xlUp).Row)
    
    ' 清空目标表
    targetSheet.UsedRange.Clear
    
    ' 复制源表的标题行到目标表
    sourceSheet.Rows(1).Copy targetSheet.Rows(1)
    
    ' 遍历源表中的每一行
    lastRow = sourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow
        ' 获取当前行的字段值
        Dim fieldValue As String
        fieldValue = sourceSheet.Cells(i, 1).Value
        
        ' 计算字段在源表中出现的次数
        count = Application.WorksheetFunction.CountIf(sourceRange, fieldValue)
        
        ' 复制当前行到目标表，复制次数为字段出现的次数
        sourceSheet.Rows(i).Copy
        targetSheet.Rows(targetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(count).PasteSpecial xlPasteAll
    Next i
    
    ' 清除剪贴板内容
    Application.CutCopyMode = False
    
    ' 提示复制完成
    MsgBox "复制完成！"
End Sub