Дублирование выбранных ячеек.

[SAS888]

Не вникал в задачу, просто фрагмент кода

Cells(ind, 1).Value = Лист1.Cells(i, 1).Value
Cells(ind, 2).Value = Лист1.Cells(i, 2).Value
Cells(ind, 3).Value = Лист1.Cells(i, 3).Value
Cells(ind, 4).Value = Лист1.Cells(i, 4).Value
Cells(ind, 5).Value = Лист1.Cells(i, 5).Value
Cells(ind, 6).Value = Лист1.Cells(i, 6).Value
Cells(ind, 7).Value = Лист1.Cells(i, 7).Value

можно заменить на

Cells(ind, 1).Resize(, 7).Value = Лист1.Cells(i, 1).Resize(, 7).Value

[Hugo121]

Да, это можно было сократить (я выше написал), но в таком виде проще что-то выкинуть или поменять порядок, как обычно бывает в таких задачах.
Но заказчик может этот блок и заменить, я не против

[Hugo121]

И кстати - в реальном примере объединённых много, поэтому в итоге эти 7 строк превращаются в

        With Лист1
            If .Cells(i, 7).Value > 0 Then
                ind = ind + 1
                If .Cells(i, 1).MergeCells Then
                    Cells(ind, 1).Value = .Cells(.Cells(i, 1).MergeArea.Row, 1).Value
                Else
                    Cells(ind, 1).Value = .Cells(i, 1).Value
                End If

                If .Cells(i, 2).MergeCells Then
                    Cells(ind, 2).Value = .Cells(.Cells(i, 2).MergeArea.Row, 2).Value
                Else
                    Cells(ind, 2).Value = .Cells(i, 2).Value
                End If

                Cells(ind, 3).Value = .Cells(i, 3).Value

                If .Cells(i, 4).MergeCells Then
                    Cells(ind, 4).Value = .Cells(.Cells(i, 4).MergeArea.Row, 4).Value
                Else
                    Cells(ind, 4).Value = .Cells(i, 4).Value
                End If

                Cells(ind, 5).Value = .Cells(i, 5).Value
                Cells(ind, 6).Value = .Cells(i, 6).Value
                Cells(ind, 7).Value = .Cells(i, 7).Value
            End If
        End With

или если один подход для всех и не нужно менять порядок:

        With Лист1
            If .Cells(i, 7).Value > 0 Then
                ind = ind + 1
                For x = 1 To 7
                If .Cells(i, x).MergeCells Then
                    Cells(ind, x).Value = .Cells(.Cells(i, x).MergeArea.Row, x).Value
                Else
                    Cells(ind, x).Value = .Cells(i, x).Value
                End If
                Next
            End If
        End With