Скопируйте весь диапазон в VBA (только значения)

Поскольку вы начинаете работать с VBA, я хочу отметить, что иногда решения могут быть немного более сложными, чем необходимо. То, что у вас есть, похоже на комбинацию решения, которое вы нашли в Интернете, но не совсем поняли, что они делают, и записи макроса.

Если вы хотите взять необработанный диапазон ячеек и просто что-то сделать с этим диапазоном, вы можете вызвать его напрямую или изменить его, а затем вызвать. Если вам нужно просмотреть диапазон с логикой типа «игнорируя пробелы, скопируйте ячейки внутри этого диапазона», тогда вам нужно будет перебрать их.

Sub Copy1()
    Dim rng As Range

    Set rng = Range("B8:GS56")

    rng.Copy

End Sub

Еще лучше, поскольку вы копируете, предположительно, вы можете куда-то вставлять эти данные, но на самом деле вы можете пропустить весь процесс копирования и вставки в vba, сказав это, как показано ниже. Легко мыслить как пользователь Excel, но следует понимать, что некоторые шаги, такие как выбор ячеек, копирование данных, вставка данных, могут оказаться совершенно ненужными этапами вашего проекта.

Sub Copy2()
'This will copy the data in A1 to cell A2
    Dim rng1 As Range, rng2 As Range

    Set rng1 = Range("A1")
    Set rng2 = Range("A2")

    rng2 = rng1

End Sub

Однако в случае, если в вашем диапазоне несколько ячеек, вы все равно захотите вставить их, но их можно будет обработать сразу.

Sub Copy3()
'This will copy the data in A1:A2 to cell B2:B3 (even with B3 not said explicitly)
    Dim rng1 As Range, rng2 As Range

    Set rng1 = Range("A1:A2")
    Set rng2 = Range("B2")

    rng1.Copy Destination:=rng2

End Sub

• Ваш код близок к завершению, вам просто нужно изменить строку кода.

• Select в большинстве случаев не требуется.

Как избежать использования Select в Excel VBA

Sub Copy1()
    Dim rng As Range, r As Range, rSel As Range
    
    Set rng = Range("B8:GS56")
    Set rSel = Nothing
    
    For Each r In rng
        If r.Value <> "" Then
            If rSel Is Nothing Then
                Set rSel = r
            Else
                Set rSel = Range(rSel, r) ' **
            End If
        End If
    Next r
    If Not rSel Is Nothing Then
        rSel.Select
        Selection.Copy
        ' Copy to somewhere
'        rSel.Copy Sheets(2).Range("B100")
    End If
End Sub

Копировать значения

• Вот распространенный сценарий.
• Не используйте Select и любые ароматы Active без необходимости.
• Вы можете копировать значения путем присвоения без использования (медленного) метода Range.Copy.

Sub CopyValues()
    
    ' Define constants.
    
    Const SRC_SHEET_NAME As String = "Sheet1"
    Const SRC_RANGE_ADDRESS As String = "B8:GS56"
    Const DST_SHEET_NAME As String = "Sheet2"
    Const DST_FIRST_CELL_ADDRESS As String = "A2"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the source 'area' range ('sarg'), the range from the first cell
    ' to the intersection between the last (bottom-most) non-blank row
    ' and the last (right-most) non-blank column of the given range ('srg').
    
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET_NAME)
    Dim srg As Range: Set srg = sws.Range(SRC_RANGE_ADDRESS)
    
    Dim slcell As Range:
    Set slcell = srg.Find("*", , xlValues, , xlByRows, xlPrevious)
    
    If slcell Is Nothing Then
        MsgBox "All cells are blank in """ & sws.Name & "!" & srg.Address(0, 0) _
             & """!", vbExclamation
        Exit Sub
    End If
    
    Dim slRow As Long: slRow = slcell.Row
    
    Set slcell = srg.Find("*", , xlValues, , xlByColumns, xlPrevious)
    Dim slCol As Long: slCol = slcell.Column
    
    Dim sarg As Range:
    Set sarg = sws.Range(srg.Cells(1), sws.Cells(slRow, slCol))
    
    ' Reference the destination range ('drg'), the range starting
    ' with the given cell ('dcell') resized to the same number
    ' of rows and columns of the source 'area' range ('sarg').
    
    Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET_NAME)
    Dim dcell As Range: Set dcell = dws.Range(DST_FIRST_CELL_ADDRESS)
    
    Dim drg As Range:
    Set drg = dcell.Resize(sarg.Rows.Count, sarg.Columns.Count)
    
    ' Copy values.
    
    drg.Value = sarg.Value
    
    ' Inform.
    
    MsgBox "Copied values from """ & sws.Name & "!" & sarg.Address(0, 0) _
        & """ to """ & dws.Name & "!" & drg.Address(0, 0) & """.", vbInformation
    
End Sub

При этом в указанное место на другом листе будут скопированы только те ячейки внутри области диапазона, которые заполнены константами (т. е. значениями, а не формулами):

Sub test()    

    ' set-up
    Dim sourcerange As Range, destinationcell As Range
    Dim cells_with_constants As Range, boundary As Range, i As Integer
    
    Set sourcerange = Worksheets("Sheet1").Range("B8:GS56") 'change Sheet1 if necessary
    Set destinationcell = Worksheets("Sheet2").Range("a1") 'change as necessary
    
    'get cells within range that have values
    Set cells_with_constants = sourcerange.SpecialCells(xlCellTypeConstants)
    
    'find boundary of those cells
    With cells_with_constants
        Set boundary = .Areas(1)
        For i = 2 To .Areas.Count
            Set boundary = Range(boundary, .Areas(i))
        Next
    End With
    
    'copy all cells within boundary
    destinationcell.Resize(boundary.Rows.Count, boundary.Columns.Count).Value = boundary.Value
        
End Sub