Question

如下面的代码，输入字段是B3，C18，C20，C22，C24。（固定输入字段）这些数据将从B41开始粘贴：F41。

问题是，每次使用宏时，如何将输出参考B41：F41的增量设为行+1？考虑一下，如果B41中有数据：F41，那么粘贴范围将是B42：F42，依此类推。

Private Sub CommandButton2_Click()

Range("B3").Copy Range("C41")

Range("C18").Copy Range("B41")
Range("C20").Copy Range("D41")
Range("C22").Copy Range("E41")
Range("C24").Copy Range("F41")

Answer 1

如果没有空值复制到ColB，则：

Private Sub CommandButton2_Click()
    Dim sht As WorkSheet
    Set sht = ActiveSheet
    With sht.Cells(sht.Rows.Count, 2).End(xlUp).Offset(1, 0).EntireRow
        sht.Range("B3").Copy .Cells(3)
        sht.Range("C18").Copy .Cells(2)
        sht.Range("C20").Copy .Cells(4)
        sht.Range("C22").Copy .Cells(5)
        sht.Range("C24").Copy .Cells(6)
    End With

Answer 2

我建议先将数据传输到数组，然后将此数组传输到工作表的必需部分。

Sub Copy_Paste_Macro()

    Dim CopyRange As Range, c As Range
    Dim HoldArray() As Variant
    Dim n As Long, i As Long

    With Worksheets("Sheet1")

        'Define Non-Contiguous range
        Set CopyRange = Range("B3, C18, C20, C22, C24")

        'Count of cells in range
        n = CopyRange.Cells.Count

        'Resize the array to hold the data
        ReDim HoldArray(1 To n)

        n = 1

        'Store the values from that range into array
        For Each c In CopyRange.Cells

            HoldArray(n) = c.Value
            n = n + 1

        Next c

    End With

    'Paste array as contiguous range

    If Worksheets("Sheet1").Range("B41") = "" Then

        Worksheets("Sheet1").Range("B41").Resize(1, UBound(HoldArray)).Value = HoldArray

    Else

        Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, UBound(HoldArray)).Value = HoldArray

    End If

End Sub

Answer 3

你可以

在数组中收集输入值
一次性写下

如下：

Option Explicit

Private Sub CommandButton2_Click()
    With Worksheets("SheetName") '<--| change "SheetName" to your actual sheet name
        .Cells(WorksheetFunction.Max(41, .Cells(.Rows.COUNT, 2).End(xlUp).Offset(1).row), 2).Resize(, 5) = GetValues(.Range("C18,B3,C20,C22,C24")) '<--| list input cells addresses in wanted output order
    End With

    ... other code

End Sub

Function GetValues(rng As Range) As Variant
    Dim cell As Range
    Dim iCell As Long

    ReDim vals(1 To rng.COUNT) As Variant
    For Each cell In rng
        iCell = iCell + 1
        vals(iCell) = cell.Value
    Next cell
    GetValues = vals
End Function

粘贴引用中的行增量

3 个答案: