粘贴参考中的行增量

如下面的代码,input字段是B3,C18,C20,C22,C24。 (固定input字段)这些数据将从B41:F41开始粘贴。

问题是,每次使用macros时,如何将输出参考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") 

如果不存在复制到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 

我build议首先将数据传输到数组,然后将此数组传递到工作表的必需部分。

 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 

你可以

  • 收集数组中的input值

  • 写在一个镜头

如下所示:

 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