查找,复制,粘贴从一张工作表到另一个循环,如果找不到,将文本插入单元格

时间:2019-10-14 10:49:45

标签: excel vba

我有以下代码,该代码循环并搜索一系列工作表,并在找到正确值时将其复制并粘贴到“爆炸列表”工作表中:

Sub CopySingle()

    Dim wsfr As Worksheet
    Dim wsl As Worksheet
    Dim BlNumber As String
    Dim BSStep As Long

    Dim SI As String
    Dim Srng As Range
    Dim Nrng As Range

    Dim Rrng As Range
    Dim Brng As Range

    Dim Arng As Range

    Application.ScreenUpdating = False

    BSStep = 1

    Set Rrng = ThisWorkbook.Worksheets("Blast List").Range("A3", Range("A3").End(xlDown))

    Set Srng = ThisWorkbook.Worksheets("Blast List").Range("E1:Q1")

    For Each Brng In Rrng.Cells

        For Each Nrng In Srng.Cells

        On Error Resume Next

        SI = Nrng.Value

        BlNumber = CStr("Blasted " & BSStep)

        Set wsfr = ThisWorkbook.Worksheets(CStr(BlNumber))
        Set wsl = ThisWorkbook.Worksheets("Blast List")

        wsfr.Select
            Range("A1").Select
                Cells.Find(What:=SI, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
                Selection.Copy

        Sheets("Blast List").Select
            Range("A1").Select
                Cells.Find(What:=BlNumber, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).End(xlToRight).Offset(0, 1).Select

                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False

        Next Nrng

        BSStep = BSStep + 1

    Next Brng

    Application.ScreenUpdating = True

End Sub

我现在正在尝试找出如何修改代码,如果找不到该值,它将在单元格中以红色显示文本“ NO INFORMATION”。

任何人和所有帮助表示赞赏。

致谢

0 个答案:

没有答案