当找到"x“并且没有重复时，如何编写代码将数据从一个工作表复制到另一个工作表？

Question

我正在试着弄清楚如何做一个宏，它将数据从一个标题为二手车日志的工作表复制到另一个标题为二手车挂起的工作表上，但仅当在二手车日志的列L中找到x时。如果在列L中找到x，那么我需要将单元格B到K (在该行上)中的所有数据复制到Used Pending到相应的列B到K中。我需要它来找到下一个要插入它的空行，并且我需要它不复制任何数据。任何帮助都将不胜感激！我正在使用Excel2007。

Answer 1

下面的代码将完全满足您的要求，但仅此而已。它将L列中的值设置为xx (而不仅仅是x)，以不复制数据两次，并假定L列中的x-es是有序的，当然，这可能是一个错误的假设。

Sub CopyData()
Dim run As Boolean
Dim i As Integer
i = 1
run = True
While run
    If Worksheets("Used Car Log").Range("L" + CStr(i)).Value = "x" Then
        Worksheets("Used Pending").Range("B" + CStr(i) + ":K" + CStr(i)).Value = Worksheets("Used Car Log").Range("B" + CStr(i) + ":K" + CStr(i)).Value
        'Mark the value as copied by setting the value in column L as xx
        Worksheets("Used Car Log").Range("L" + CStr(i)).Value = "xx"
    ElseIf Worksheets("Used Car Log").Range("L" + CStr(i)).Value = "" Then
        run = False
    End If

    i = i + 1
Wend


End Sub

Answer 2

你有没有试过使用IF函数？

例如，在Used Pending工作表中，您可以在单元格A1中使用如下公式

=IF(UsedCarLog!L1="x",UsedCarLog!A1,"")

然后，删除Used Pending工作表中的所有空行。

Answer 3

试试这个：

Sub FindAndMove()

Dim LastrowUP As Integer
Dim LastrowCarLog As Integer
Dim RowNumber As Integer

LastrowCarLog = Sheets("Used Car Log").Cells(Cells.Rows.Count, "B").End(xlUp).Row

For Each c In Sheets("Used Car Log").Range("L1:L" & LastrowCarLog)
 If c.text = "x" Then
 RowNumber = c.Row
 LastrowUP = Sheets("Used Pending").Cells(Cells.Rows.Count, "B").End(xlUp).Row
 Sheets("Used Car Log").Range("B" & RowNumber & ":" & "K" & RowNumber).Copy
 Sheets("Used Pending").Range("B" & LastrowUP + 1).PasteSpecial Paste:=xlPasteValues
 Application.CutCopyMode = False
 End If
Next c

Sheets("Used Pending").Range("B1:K" & LastrowUP + 1).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7 , 8, 9, 10), Header:=xlNo

End Sub

粘贴到VB编辑器中的新模块中。然后，在电子表格上创建一个按钮，右键单击，选择“分配宏”，然后选择FindAndMove