Я пытаюсь скопировать непустые и не объединенные ячейки с диапазоном и вставить его в другой сводный лист - PullRequest
0 голосов
/ 20 апреля 2020
Sub SelectAllNonBlankCells()
    Dim objUsedRange As Range
    Dim objRange As Range
    Dim objNonblankRange As Range

    Application.ScreenUpdating = False
    Set sh = Worksheets("Summary")  ' Summary Sheet
    sh.Range("A11:P1000").Clear

    Set objUsedRange = Application.ActiveSheet.Range("B4:B15")

    For Each objRange In objUsedRange
        If Not (objRange.Value = "" And objRange.MergeCells = True) Then
           If objNonblankRange Is Nothing Then
              Set objNonblankRange = objRange
           Else
              Set objNonblankRange = Application.Union(objNonblankRange, objRange)
           End If
        End If
    Next

    If Not (objNonblankRange Is Nothing) Then
       objNonblankRange.Copy
       sh.Range("B11").PasteSpecial Transpose:=True
    End If
End Sub

Referance cells to the code

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...