如果满足特定条件，如何从另一张表中的每一行复制特定单元格？

Question

所以我的问题是这样的。我有一个工作簿，可以说 2 张。我已经从另一个程序和 sheet1 自动创建了 sheet2，我只想要 sheet2 中的一些信息。

我现在正在尝试创建一个宏，它将检查从 14 开始的每一行，并且 E% 中的值大于 15。如果满足条件，我希望宏将单元格值从 C% 和 E% 复制到sheet1 让我们在 A5 和 B5 中说，然后继续到 sheet2 中的下一行，将值粘贴到 A6 B6 等等。

Sub Test()
    Dim rng As Range
    Dim lastRow As Long
    Dim cell As Variant


    With Sheets("Sheet2")


        lastRow = .Range("E" & .Rows.Count).End(xlUp).Row
        Set rng = .Range("E14:E" & lastRow)


        For Each cell In rng
            If cell.Value > 15 Then
            'And here is where it gets bugged. I know theres something wrong with the .select but I couldnt think of any other way to
            'pick only just the 2 cells needed.
                Range(cell.Offset(0, -1), cell.Offset(0, 0)).Select
                Selection.Copy

                'In here there should also be some code to select where to place the copyed
                'data but since it already got bugged couldnt really find a solution for 
                'it..
                Sheets("Sheet1").Select
                ActiveSheet.Paste
                Sheets("Sheet2").Select

            End If
        Next
    End With


End Sub

Answer 1

所以我想我会把它放在一起：

Sub Test()
Dim rng As Range
Dim lastRow As Long
Dim cell As Variant
dim count as long
count = 0

With Sheets("Sheet2")


    lastRow = .Range("E" & .Rows.Count).End(xlUp).Row
    Set rng = .Range("E14:E" & lastRow)


    For Each cell In rng
        If cell.Value > 15 Then
        'And here is where it gets bugged. I know theres something wrong with the         .select but I couldnt think of any other way to
        'pick only just the 2 cells needed.
            Range(cell.Offset(0, -1), cell.Offset(0, 0)).Select
            Selection.Copy
        'maybe use: Range(cell.Offset(0, -1), cell.Offset(0, 0)).copy


            'In here there should also be some code to select where to place the copyed
            'data but since it already got bugged couldnt really find a solution for 
            'it..
            Sheets("Sheet1").Activate
            Range("A5", B5).offset(count, 0).PasteSpecial 'this will make it so that it starts in a5, and moves down a row each time
            count = count + 1            'dont forget to increment count

            Sheets("Sheet2").Activate

        End If
    Next
End With


End Sub

这是一件很艰难的事情..

您可能会包含一些错误处理，例如：if not cell.value = "" then 或 if not isNumeric(cell.value) then，它们一起将确保您只处理带有数字的非空白单元格。