求助VBA

Sub CopyDataBasedOnAllMergedCells()
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim currentCell As Range
Dim mergedCell As Range
Dim startCell As Range
Dim endCell As Range
Dim startRow As Long
Dim endRow As Long
Dim targetRow As Long
Dim mergeCount As Long '新增变量，用于记录合并单元格的个数
Set wsSource = ThisWorkbook.Sheets("Sheet1") '源工作表，可根据实际修改
Set wsTarget = ThisWorkbook.Sheets("Sheet2") '目标工作表，可根据实际修改
mergeCount = 0 '初始化合并单元格个数为0
'先从B2单元格开始判断
Set currentCell = wsSource.Range("B2")
Do While True
'判断当前单元格是否为合并单元格
If currentCell.MergeCells Then
mergeCount = mergeCount + 1 '找到一个合并单元格，个数加1
Set mergedCell = currentCell.MergeArea
Set startCell = mergedCell.Cells(1)
Set endCell = mergedCell.Cells(mergedCell.Cells.Count)
startRow = startCell.Row
endRow = endCell.Row
targetRow = 3 + (mergeCount - 1) * 22 '根据合并单元格个数计算目标行号
wsSource.Range("C" & startRow & ":F" & endRow).Copy wsTarget.Cells(targetRow, "B")
Set currentCell = endCell.Offset(1) '从当前合并单元格区域的最后一个单元格往下移一个单元格继续判断
Else
If currentCell.Row > wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row Then
Exit Do '如果当前单元格超出了B列有数据的最后一行，结束循环
End If
Set currentCell = currentCell.Offset(1) '如果当前单元格不是合并单元格，往下移一个单元格继续判断
End If
Loop
End Sub