按范围(而不是按单元格)复制和粘贴值

Question

我试图获得下面的代码来粘贴我想要的值作为值，但是要通过块范围，而不是单元格来实现。

我已经尝试了下面的代码和其他一些例子，但是这个例子非常接近我想要的。

Sub main()

Dim LastRow As Long
Dim i As Integer
For i = 6 To 30
    If IsEmpty(Sheets("Main").Cells(i, 6).Value) = False Then

    Sheets("SSCC_Bin").UsedRange 'refreshes sheet2
    LastRow = Sheets("SSCC_Bin").UsedRange.Rows(Sheets("SSCC_Bin").UsedRange.Rows.Count).Row 'find the number of used rows

    Sheets("Main").Cells(i, 5).Offset(0, -2).Copy
    Sheets("SSCC_Bin").Range("A1").Offset(LastRow, 0).PasteSpecial xlPasteValues
    'copies and pastes the data

Else
End If
Next i

End Sub

我在表格'Main‘的C栏中有公式，它是序号。我要他们在一个动议中移动到SSCC_Bin。上面的代码是逐个单元格的，这和我的公式是一样的。

Answer 1

您可以尝试使用以下内容。这将根据空单元格的位置以块形式“复制”Main工作表中的值。

Sub main()
    Dim LastRow As Long, DestRow As Long
    Dim i As Long
    With Sheets("SSCC_Bin")
        DestRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

    With Sheets("Main")
        LastRow = .Cells(.Rows.Count, 6).End(xlUp).Row
        For i = 6 To LastRow
            ' Skips over empty cells
            If Not IsEmpty(.Cells(i, 6)) Then
                ' Gets CurrentRegion - basically all surrounding cells that are populated
                With Intersect(.Cells(i, 6).CurrentRegion, .Columns(6))
                    ' Same as PasteSpecial xlPasteValues but faster           
                    Sheets("SSCC_Bin").Cells(DestRow, 1).Resize(.Rows.Count, .Columns.Count).Value2 = .Value2
                    ' Updates where the next data set is to be added too
                    DestRow = DestRow + .Rows.Count
                    ' Increase i for the rows that we have already handled
                    i = i + .Rows.Count
                End With
            End If
        Next i
    End With
End Sub

Answer 2

下面的代码可能适用于您。我还没试过这个。

您可以使用SpecialCells函数查找常量，而不是循环遍历每个单元格并检查其是否为空。

Sub Macro1()

Dim LastRow As Long    

    Sheets("SSCC_Bin").UsedRange 'refreshes sheet2
    LastRow = Sheets("SSCC_Bin").UsedRange.Rows(Sheets("SSCC_Bin").UsedRange.Rows.Count).Row 'find the number of used rows

    Sheets("Main").Range("F6:F30").SpecialCells(xlCellTypeConstants, 23).Copy
    Sheets("SSCC_Bin").Range("A1").Offset(LastRow, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

注意事项：如果您的范围有公式的话，这段代码就不能工作

Answer 3

我知道你有另一个答案，这是一个基本的解决方案和评论。

With ThisWorkbook.Sheets("Main")
    'Hide the rows in column 6 if the cell is empty
    .Columns(6).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True

    'Copy only the visible cells in the range
    .Range("C6:C30").SpecialCells(xlCellTypeVisible).Copy

    'paste the range to the next cell after the last used cell in column A
    Sheets("SSCC_Bin").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

End With

'Clear the marching ants
Application.CutCopyMode = False