Question

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

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代码。我有一个解决方法

Private Sub 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

End Sub

将范围复制到特定行/单元格中，避免覆盖数据

2 个答案: