Question

我有一个代码可以将数据从一个工作表复制到另一个工作表，如下所示，但其查找部分无效。如果我不使用此查找功能，那么代码运行良好

Sub CopyRows()

Dim Rng As Range
Dim Rng2 As Range
Dim Cl As Range
Dim str As String
Dim RowUpdCrnt As Long

Set UsedRange = Sheets("Jan").Range("b5:bk81")
Set Rng = Sheets("Jan").UsedRange  'the range to search ie the used range
Set Rng2 = Sheets("Feb").Range("I5:AK5")

str = "WRK." 'string to look for
Sheets("Feb").Range("B5:B81").Value = ""
RowUpdCrnt = 5

' In my test data, the "WRK."s are in column AN.  This For-Each only selects column AN.
' I assume all my "WRK."s are in a single column.  Replace "B" by the appropriate
' column letter for your data.

For Each Cl In Rng.Columns("AN").Rows
    If Cl.Text = str Then
        'if the cell contains the correct value copy it to next empty row on sheet 2 &  delete the row
        VLookup(Cl.EntireRow.Range("b1"), Sheets("Master").Range("H7:H200"), 1, 0).Copy
        Sheets("Feb").Cells(RowUpdCrnt, 2).PasteSpecial xlPasteValues
        RowUpdCrnt = RowUpdCrnt + 1
    End If
Next Cl
Application.CutCopyMode = False

End Sub

Answer 1

根据您的帖子，您要复制的唯一内容是值，因此您可以使用Sheets("Feb").Range("B" & RowUpdCrnt).Value = Application.VLookup(.Range("B" & Cl.Row).Value, Sheets("Master").Range("H7:H200"), 1, 0)

来限定单元格（不使用复制＆gt;＆gt;粘贴）

尝试以下代码：

With Sheets("Jan")
    ' loop until last row with data in Column AN (and not the entire column) to save time
    For Each Cl In .Range("AN1:AN" & .Cells(.Rows.Count, "AN").End(xlUp).Row) 
        If Cl.Value Like str Then
            'if the cell contains the correct value copy it to next empty row on sheet 2 &  delete the row
            If Not IsError(Application.VLookup(.Range("B" & Cl.Row).Value, Sheets("Master").Range("H7:H200"), 1, 0)) Then   ' <-- verify the VLookup was successful
                Sheets("Feb").Range("B" & RowUpdCrnt).Value = Application.VLookup(.Range("B" & Cl.Row).Value, Sheets("Master").Range("H7:H200"), 1, 0)
                RowUpdCrnt = RowUpdCrnt + 1
            End If
        End If
    Next Cl
End With

vlookup和条件复制数据vba

1 个答案: