复制到下一个空行的问题答案

【问题标题】：Problems with copying to the next empty row复制到下一个空行的问题
【发布时间】：2022-08-18 23:05:42
【问题描述】：

如果wsDestination 中不存在数据，我正在尝试将数据从wsSource 复制到wsDestination。如果数据不存在，则数据复制，但它复制到最后一行而不是下一个空行。

我附上了屏幕截图来说明这一点

Screenshot showing data from wsDestination before any copy is done

Screenshot showing data in wsDestination after data has been copied

Sub test()
    Dim wsSource As Worksheet, wsDestination As Worksheet
    Dim LastRowSource As Long, LastRowDestination As Long
    Dim i As Long, y As Long
    Dim Value_1 As String, Value_2 As String, Value_3 As String
    Dim ValueExists As Boolean

    With ThisWorkbook
        Set wsSource = .Worksheets(\"Data Source\")
        Set wsDestination = .Worksheets(\"Data Destination\")
    End With

    With wsSource
        \'Find the last row of Column C, wsSource
        LastRowSource = .Cells(.Rows.Count, \"C\").End(xlUp).Row
        \'Loop Column C, wsSource
        For i = 13 To LastRowSource
            \'Data to be tested if it doesn\'t exist in wsDestination
            Value_1 = .Range(\"B\" & i).Value 
            Value_2 = .Range(\"C\" & i).Value
            Value_3 = .Range(\"D\" & i).Value
            ValueExists = False

            With wsDestination
                \'Find the last row of Column B, wsDestination
                LastRowDestination = .Cells(.Rows.Count, \"B\").End(xlUp).Row
                \'Loop Column B, wsDestination
                For y = 5 To LastRowDestination
                    \'Check to see whether data exists
                    If .Range(\"B\" & y).Value = Value_1 Then
                        ValueExists = True
                        Exit For
                    End If
                Next y

                \'If data doesn\'t exist in wsDestination then copy data to next available row 
                If ValueExists = False Then
                    .Range(\"B\" & y).Value = Value_1
                    .Range(\"C\" & y).Value = Value_2
                    .Range(\"D\" & y).Value = Value_3
                End If
            End With
        Next i
    End With
End Sub

Screenshot 4 showing results after amended code

标签： excel vba

【解决方案1】：

如果我理解您的问题，您总是希望填写目标工作表上的下一个空白范围。首先检查这一行：

For y = 5 To LastRowDestination

此循环将从第 5 行开始，该行是目标工作表上的标题行。您不想意外覆盖它，因此您从第 6 行开始循环，如下所示：

For y = 6 To LastRowDestination

此行将检查您的行到目标工作表上的最后一行。因此，如果每个空行都已填满，它将转到您的最后（非空）行：

LastRowDestination = .Cells(.Rows.Count, "B").End(xlUp).Row

您要检查 + 1 行（保证为空行）。

LastRowDestination = .Cells(.Rows.Count, "B").End(xlUp).Row + 1

您不需要 ValueExists 标志，您可以像这样检查范围是否为空：

If WorksheetFunction.CountA(.Range("B" & y & ":D" & y)) = 0 Then ' EMPTY RANGE

所以这里是你的代码的清理版本：

Sub test()
Dim wsSource As Worksheet, wsDestination As Worksheet
Dim LastRowSource As Long, LastRowDestination As Long
Dim i As Long, y As Long

    With ThisWorkbook
        Set wsSource = .Worksheets("Data Source")
        Set wsDestination = .Worksheets("Data Destination")
    End With
        
    With wsSource
        'Find the last row of Column C, wsSource
        LastRowSource = .Cells(.Rows.Count, "C").End(xlUp).Row
        'Loop Column C, wsSource
        For i = 13 To LastRowSource
            With wsDestination
                'Find the last row of Column B, wsDestination
                LastRowDestination = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
                'Data to be tested if it doesnt exist in wsDestination
                'if IsError is true, data does not exist in wsDestination
                If IsError(Application.VLookup(.Range("B" & i), .Range("B6:B" & LastRowDestination), 1, False)) Then
                    'Loop Column B, wsDestination
                    For y = 6 To LastRowDestination
                        'Check to see whether data existsd
                        If WorksheetFunction.CountA(.Range("B" & y & ":D" & y)) = 0 Then ' EMPTY RANGE
                            .Range("B" & y) = wsSource.Range("B" & i)
                            .Range("C" & y) = wsSource.Range("C" & i)
                            .Range("D" & y) = wsSource.Range("D" & i)
                            Exit For
                        End If
                    Next y
                End If
            End With
        Next i
    End With
End Sub

【讨论】：

彼得感谢您的回答和新代码。新代码复制到 wsDeatination 中的下一个空行。但是如果数据已经存在于 wsDestination 中，它仍然会从 wsSource 复制。你帮帮忙吗？
更新了代码，它将检查'Ref Num'（希望这是一个唯一的ID），如果没有找到，它将在下一个空范围内插入数据。
感谢彼得非常感谢您的帮助。我已经尝试了代码，但现在没有任何反应，也没有任何内容被复制到其中。 ws目的地。这是我做错了什么吗？
打扰一下！插入数据时我错过了工作表引用 (wsSource)。我修好了，现在应该可以了！
谢谢彼得，代码现在运行并复制到下一个空行。然而，数据存在于 wsDestination 的 B 列和 D 列中，它仍然会复制数据。只有在运行宏 4 次后，它才会识别出 wsDestination 中存在的数据。你对此有什么想法吗？