根据单元格值在VBA中复制和粘贴循环

问题描述：

我正在尝试创建一些可以通过一系列单元格的代码，并将满足特定参数的单元格复制并粘贴到工作簿中的不同位置。

I am trying to create some code that looks through a range of cells and will copy and paste the cells that meet a specific parameter to a different location in the workbook.

我想从sheet5中复制字母L的任何东西，并将特定范围复制到sheet1

I would like to copy anything with the letter L from "sheet5" and copy a specific range to "sheet1"

我必须在代码的循环部分出错，因为只有单元格范围的顶部被复制。我希望粘贴从第5行开始，继续向下移动。这是否意味着我正确地将IRow = IRow + 1放在粘贴功能之下？

I must have something wrong with the loop part of the code because only the top of the cell range is being copied. I would like the pasting to start at row 5 and continue moving downward. Does this mean I correctly put the IRow = IRow + 1 below the paste function?

Sub Paste_Value_Test()

Dim c As Range
Dim IRow As Long
Dim rDestination As Excel.Range

Application.ScreenUpdating = False
Sheets("sheet5").Activate
For Each c In Sheets("sheet5").Range("b2", Range("N65536").End(xlUp))
    If c.Value = "L" Then
        Sheets("sheet5").Cells(c.Row, 2).Copy

        Set rDestination = Worksheets("sheet5").Cells(5 + IRow, 12)

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

        IRow = IRow + 1

    End If
Next c

End Sub

我非常感谢任何帮助。我对VBA比较新，我将开始认真挖掘。

I really appreciate any help on this. I'm relatively new to VBA and am going to start seriously digging in.

答

这是你正在尝试的任何机会？我已经评论过代码，所以你不应该有任何问题的理解。

Is this what you are trying by any chance? I have commented the code so you shouldn't have any problem understanding it.

Sub Paste_Value_Test()
    Dim c As Range
    Dim IRow As Long, lastrow As Long
    Dim rSource As Range
    Dim wsI As Worksheet, wsO As Worksheet

    On Error GoTo Whoa

    '~~> Sheet Where "L" needs to be checked
    Set wsI = ThisWorkbook.Sheets("Sheet5")
    '~~> Output sheet
    Set wsO = ThisWorkbook.Sheets("Sheet1")

    Application.ScreenUpdating = False

    With wsI
        '~~> Find Last Row which has data in Col B to N
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lastrow = .Columns("B:N").Find(What:="*", _
                          After:=.Range("B1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lastrow = 1
        End If

        '~~> Set you input range
        Set rSource = .Range("B2:N" & lastrow)

        '~~> Search for the cell which has "L" and then copy it across to sheet1
        For Each c In rSource
            If c.Value = "L" Then
                .Cells(c.Row, 2).Copy
                wsO.Cells(5 + IRow, 12).PasteSpecial Paste:=xlPasteValues

                IRow = IRow + 1
            End If
        Next
    End With

LetsContinue:
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

根据单元格值在VBA中复制和粘贴循环

相关推荐