Public Function copyMergeRow(RowSource As range, shTarget As Worksheet, intRow As Integer)
'RowSource - исходная строка как объект
' shTarget - целевой лист как объект
' номер строки под которым нужно вставить копируемую строку
Dim rngCell As range
On Error GoTo Err_copyMergeRow
On Error GoTo Err_mer
RowSource.Copy shTarget.Rows(intRow)
If IsNull(RowSource.MergeCells) Then
For Each rngCell In RowSource.Cells
With rngCell
If .MergeCells Then
.MergeArea.Cells(1, 1).Copy shTarget.Cells(intRow, .Column)
End If
End With
Next
End If
Exit_copyMergeRow:
Exit Function
Err_copyMergeRow:
Select Case Err.Number
Case Else
MsgBox "(" & Err.Number & ") " & Err.Description & " в процедуре copyMergeRow "
Resume Exit_copyMergeRow
End Select
End Function
'пример вызова:
' копирует строки с 1 по 12 с "лист1" на "лист2"
Dim i As Integer
For i = 1 To 12
Call copyMergeRow(Worksheets("Лист1").Rows(i), Worksheets("Лист2"), i )
Next
|