将 Range 复制到 Specific Row/Cell 并避免覆盖数据

Question

VBA Excel 相当陌生。我想在满足条件时（当 C 列等于否时）将特定单元格 [B11 等）复制并粘贴到目标 sheet 上的特定单元格 [E9 等] 中。到目前为止，我能够将数据复制并粘贴到我的目标 sheet 上。当我再次运行命令时遇到问题。我不想覆盖我以前的数据。如何才能做到这一点？ `

Private Sub CommandButton1_Click()

    Dim RowGCnt As Long, CShtRow As Long
    Dim LastRow As Long
    Dim CellG As Range

    'paste the first result to the 9th row
    CShtRow = 9
    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

    For RowGCnt = 11 To LastRow
        If Range("C" & RowGCnt).Value = "No" Then
            MsgBox (CShtRow)
            'Review Criteria
            Worksheets("SHEET1").Range("B" & RowGCnt).Copy
            Worksheets("REPORT").Range("E" & CShtRow).PasteSpecial xlPasteValues
            CShtRow = CShtRow + 1
        End If
    Next RowGCnt

    Application.CutCopyMode = False

End Sub

Answer 1

未测试：

Private Sub CommandButton1_Click()

    Dim shtSrc As Worksheet '<< source sheet
    Dim RowGCnt As Long
    Dim LastRow As Long
    Dim cDest As Range   '<< copy destination

    Set shtSrc = Worksheets("SHEET1")

    'paste the first result to the first open row
    With Worksheets("REPORT")
        Set cDest = .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0) '<<EDIT
        If cDest.Row < 9 Then Set cDest = .Range("E9")
    End With

    LastRow = shtSrc.Range("A" & shtSrc.Rows.Count).End(xlUp).Row

    For RowGCnt = 11 To LastRow
        If shtSrc.Range("C" & RowGCnt).Value = "No" Then
            cDest.Value = shtSrc.Range("B" & RowGCnt).Value
            Set cDest = cDest.Offset(1, 0)
        End If
    Next RowGCnt

End Sub

Answer 2

使用 Tim Williams 代码。我有一个解决方法

私人订阅 CommandButton1_Click()

Dim shtSrc As Worksheet '<< source sheet
Dim RowGCnt As Long
Dim LastRow As Long
Dim cDest As Range   '<< copy destination
Dim vLastRow As Integer

Set shtSrc = Worksheets("SHEET1")

'paste the first result to the first open row
With Worksheets("REPORT")
    Set cDest = .Cells(.Rows.Count, "E").End(xlUp)
    If cDest.Row < 9 Then
        Set cDest = .Range("E9")
    Else
        vLastRow = .Cells(.Rows.Count, 5).End(xlUp).Row
        Set cDest = .Cells(vLastRow + 1, 5)
    End If
End With

LastRow = shtSrc.Range("A" & shtSrc.Rows.Count).End(xlUp).Row

For RowGCnt = 11 To LastRow
    If shtSrc.Range("C" & RowGCnt).Value = "No" Then
        cDest.Value = shtSrc.Range("B" & RowGCnt).Value
        Set cDest = cDest.Offset(1, 0)
    End If
Next RowGCnt

结束子

将 Range 复制到 Specific Row/Cell 并避免覆盖数据

Copy Range into Specific Row/Cell and avoid overwriting the data

excel

vba

copy-paste