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

How to copy specific cells from each row in another sheet if certain condition is met?

提问by DeIta

So my problem is this. I have a workbook with lets say 2 sheets. I have automatically created sheet2 from another program and sheet1 where I would like only some of the information from sheet2.

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

I am now trying to create a macro that would check each row starting from 14 with the value in E% greater than 15. If the condition is met I would like the macro to copy cell value from C% and E% to sheet1 lets say in A5 and B5 and then proceed to next row in sheet2 pasting the valued to A6 B6 and so on.

我现在正在尝试创建一个宏，该宏将检查从 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

采纳答案by user1759942

so I guess i'll put it together:

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

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

and that's kinda a rough thing..

这有点粗糙..

you might include some error handling like: if not cell.value = "" thenor also if not isNumeric(cell.value) thenand those together would ensure you're only processing non blank cells with numbers.

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